New to VBA so need your help and on an urgent basis please.. RRS feed

  • Question

  • Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 1
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:V1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    ws.AutoFilterMode = False
    End Sub

    I am using this code to parse data into different worksheets based on 1st column data. But every worksheet is created twice except the last one. Since I am new to this VBA coding, I am not able to sort out this error. Please guys can you figure out the error for me, I need to sort this out on an urgent basis.

    Thursday, October 5, 2017 6:54 AM

All replies

  • The code works OK when I try it. Perhaps some of the values in column A on Sheet1 have a space after them and some don't? For example, if you have values "name" and "name ", the code would produce sheets "name" and "name ", but the sheet tabs look very similar:

    Regards, Hans Vogelaar (

    Thursday, October 5, 2017 8:59 AM