0

I have this VBA code, when I try to run it, it gives me "Compile error: Syntax error" as can be seen in the image. I don't know VBA, what should i do to make this code work ? thanks.

 Sub MostCommonPairAndTriplet()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim strTriplet As String
Dim wsResult As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim i As Integer
Dim j As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

If Not rng Is Nothing Then

'Get the result worksheet
On Error Resume Next
Set wsResult = ActiveWorkbook.Worksheets("Results")
If wsResult Is Nothing Then
Set wsResult = ActiveWorkbook.Worksheets.Add
wsResult.Name = "Results"
Else
wsResult.UsedRange.Delete
End If
'column labels
With wsResult
.Range("B1").Value = "Value1"
.Range("C1").Value = "Value2"
.Range("D1").Value = "Count"
.Range("F1").Value = "Value1"
.Range("G1").Value = "Value2"
.Range("H1").Value = "Value3"
.Range("I1").Value = "Count"
End With
On Error GoTo 0

'Find Pairs
lRow = 2
For Each c In rng
If c.Column <= 5 Then
For i = 1 To 6 - c.Column
strPair = c.Value & "_" & c.Offset(0, i).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
wsResult.Range("A:A"), False)
If Err.Number > 0 Then
wsResult.Range("A" & lRow).Value = strPair
wsResult.Range("B" & lRow).Value = c.Value
wsResult.Range("C" & lRow).Value = c.Offset(0,
i).Value
wsResult.Range("D" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("D" & lRow2).Value =
wsResult.Range("D" & lRow2).Value 1
End If
On Error GoTo 0
Next i
End If
Next c

'Find Triplets
lRow = 2
For Each c In rng
If c.Column <= 5 Then
For i = 1 To 6 - c.Column
For j = 1 To 6 - c.Offset(0, i).Column
strTriplet = c.Value & "_" & c.Offset(0, i).Value &
"_" & c.Offset(0, i + j).Value

On Error Resume Next
lRow2 =
Application.WorksheetFunction.Match(strTriplet, wsResult.Range("E:E"), False)
If Err.Number > 0 Then
wsResult.Range("E" & lRow).Value = strTriplet
wsResult.Range("F" & lRow).Value = c.Value
wsResult.Range("G" & lRow).Value = c.Offset(0,
i).Value
wsResult.Range("H" & lRow).Value = c.Offset(0, i
+ j).Value
wsResult.Range("I" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("I" & lRow2).Value =
wsResult.Range("I" & lRow2).Value 1
End If
On Error GoTo 0
Next j
Next i
End If
Next c
End If

wsResult.Columns("E").Clear
wsResult.Columns("A").Delete

'Sort the pairs
With wsResult
.Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlDescending
.Columns("E:H").Sort Key1:=.Range("H2"), Order1:=xlDescending
End With


Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

enter image description here

1

You have unwanted line breaks in a number of places in your code. The screenshot you posted shows a number of lines highlighted in red; these are places where you'll get a syntax error, because the line is incomplete.

The line you're breaking on should be combined with the next line, to give you this result:

lRow2 = Application.WorksheetFunction.Match(strPair,wsResult.Range("A:A"), False)

In this case, the line was trying to assign a value to the variable lRow2 by using Excel's built-in MATCH function, which looks for a value within a range and returns the row number where it finds the match. However, since your line was incomplete, all it had to work with was the argument telling it which value to search for. You can tell that it was incomplete in several ways - it was highlighted in red, there was only one argument, and it had an opening parenthesis without a closing parenthesis.

In VBA, each individual instruction or method should be contained on a single line. If you need to go across multiple lines for readability, you can use the _ underscore to join two lines together. Here is your code, modified to avoid the line breaks:

EDITED:

I've assumed that the two remaining errored lines are keeping a count of how many of a certain value are found, so they're simply incrementing the value in a particular cell by 1 each time. Give this a run and let me know what you get.

Sub MostCommonPairAndTriplet()
    Dim rng As Range
    Dim c As Range
    Dim strPair As String
    Dim strTriplet As String
    Dim wsResult As Worksheet
    Dim lRow As Long
    Dim lRow2 As Long
    Dim i As Integer
    Dim j As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

    If Not rng Is Nothing Then

    'Get the result worksheet
    On Error Resume Next
    Set wsResult = ActiveWorkbook.Worksheets("Results")
    If wsResult Is Nothing Then
    Set wsResult = ActiveWorkbook.Worksheets.Add
    wsResult.Name = "Results"
    Else
    wsResult.UsedRange.Delete
    End If
    'column labels
    With wsResult
    .Range("B1").Value = "Value1"
    .Range("C1").Value = "Value2"
    .Range("D1").Value = "Count"
    .Range("F1").Value = "Value1"
    .Range("G1").Value = "Value2"
    .Range("H1").Value = "Value3"
    .Range("I1").Value = "Count"
    End With
    On Error GoTo 0

    'Find Pairs
    lRow = 2
    For Each c In rng
        If c.Column <= 5 Then
            For i = 1 To 6 - c.Column
                strPair = c.Value & "_" & c.Offset(0, i).Value

                On Error Resume Next
                lRow2 = Application.WorksheetFunction.Match(strPair, wsResult.Range("A:A"), False)
                If Err.Number > 0 Then
                    wsResult.Range("A" & lRow).Value = strPair
                    wsResult.Range("B" & lRow).Value = c.Value
                    wsResult.Range("C" & lRow).Value = c.Offset(0, i).Value
                    wsResult.Range("D" & lRow).Value = 1
                    lRow = lRow + 1
                Else
                    wsResult.Range("D" & lRow2).Value = wsResult.Range("D" & lRow2).Value + 1
                End If
                On Error GoTo 0
            Next i
        End If
    Next c

    'Find Triplets
    lRow = 2
    For Each c In rng
        If c.Column <= 5 Then
            For i = 1 To 6 - c.Column
                For j = 1 To 6 - c.Offset(0, i).Column
                    strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).Value

                    On Error Resume Next
                    lRow2 = Application.WorksheetFunction.Match(strTriplet, wsResult.Range("E:E"), False)
                    If Err.Number > 0 Then
                        wsResult.Range("E" & lRow).Value = strTriplet
                        wsResult.Range("F" & lRow).Value = c.Value
                        wsResult.Range("G" & lRow).Value = c.Offset(0, i).Value
                        wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).Value
                        wsResult.Range("I" & lRow).Value = 1
                        lRow = lRow + 1
                    Else
                        wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2).Value + 1
                    End If
                    On Error GoTo 0
                Next j
            Next i
        End If
    Next c
    End If

    wsResult.Columns("E").Clear
    wsResult.Columns("A").Delete

    'Sort the pairs
    With wsResult
    .Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlDescending
    .Columns("E:H").Sort Key1:=.Range("H2"), Order1:=xlDescending
    End With


    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub
  • I tried this code, but it still gives the same error message unfortunately. – Max Dec 27 '16 at 16:08
  • We do still have those two lines I highlighted at the end, with their dangling "1"s. It's not clear what those lines are intended to do. Can you clarify what the macro is expected to do? – Werrf Dec 27 '16 at 16:17
  • It finds and extracts common pairs and triplets from a given set of numbers. I am not familiar with vba so I can't contemplate on "1s" unfortunately. – Max Dec 27 '16 at 16:20
  • Okay - I've assumed those two lines are intended to keep a running total of how many instances of a given value have been found, so if a match is found they'll increment the value in a cell by +1. Give this a shot and let me know. – Werrf Dec 27 '16 at 16:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.