Very slow VBA

[JK1111]

Hello,

I'm quite new to VBA and I just recently wrote this code to extract data from one main worksheet to copy/paste into each respective client worksheet. Contained in the workbook is a main worksheet with currently over 5000 entries and then the 14 separate client worksheets.

Two questions:

1. It looks like each time I run the macro, it duplicates the data in the client worksheets. What I'd like it to do is just overwrite the data each time I run it for an update.
2. Are there any unnecessary steps that I've included? I'd like it to run as fast as possible.

Thank you in advance for any help you can provide.

Private Sub CommandButton1_Click()
a = Worksheets("main").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
    If Worksheets("Main").Cells(i, 3).Value = "BA" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("BA").Activate
        b = Worksheets("BA").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("BA").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "CS" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("CS").Activate
        b = Worksheets("CS").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("CS").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "CT" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("CT").Activate
        b = Worksheets("CT").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("CT").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "DE" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("DE").Activate
        b = Worksheets("DE").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("DE").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "DM" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("DM").Activate
        b = Worksheets("DM").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("DM").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "GM" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("GM").Activate
        b = Worksheets("GM").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("GM").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "JB" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("JB").Activate
        b = Worksheets("JB").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("JB").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "KJ" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("KJ").Activate
        b = Worksheets("KJ").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("KJ").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "KO" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("KO").Activate
        b = Worksheets("KO").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("KO").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "KP" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("KP").Activate
        b = Worksheets("KP").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("KP").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "ML" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("ML").Activate
        b = Worksheets("ML").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("ML").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "RD" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("RD").Activate
        b = Worksheets("RD").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("RD").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "SS" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("SS").Activate
        b = Worksheets("SS").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("SS").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
    ElseIf Worksheets("Main").Cells(i, 3).Value = "ST" Then
        Worksheets("Main").Rows(i).Copy
        Worksheets("ST").Activate
        b = Worksheets("ST").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("ST").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Main").Activate
        
    End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Main").Cells(1, 1).Select
End Sub

 

[cerfani]

you dont need to activate anything or select anything to edit your workbook... just tell the functions what to do... for example... Copy function has a parameter for destination range... those are functions that the macro recorder uses to remember user input but you dont need to script user input in vba... also you should get into the habit of declaring all variables...

Private Sub CommandButton1_Click()
    Dim a As Long, b As Long, i As Long

    a = Worksheets("main").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To a
        If Worksheets("Main").Cells(i, 3).Value = "BA" Then
            b = Worksheets("BA").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Main").Rows(i).Copy Worksheets("BA").Cells(b + 1, 1)
        ElseIf Worksheets("Main").Cells(i, 3).Value = "CS" Then
            ...
        End If
    Next
    Application.CutCopyMode = False
    ThisWorkbook.Worksheets("Main").Cells(1, 1).Select
End Sub

if you dont want to duplicate maybe you mean to cut and paste?

Using With keyword to ... (make easier to read??)

Private Sub CommandButton1_Click()
    Dim a As Long, b As Long, i As Long
    With Worksheets("main") 
        a = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To a
            If .Cells(i, 3).Value = "BA" Then
                b = Worksheets("BA").Cells(Rows.Count, 1).End(xlUp).Row
                .Rows(i).Copy Worksheets("BA").Cells(b + 1, 1)
            ElseIf .Cells(i, 3).Value = "CS" Then
                ...
            End If
        Next
        Application.CutCopyMode = False
        .Cells(1, 1).Select
    End With
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Untested, but try

Sub UpdateData()

   Dim Mws As Worksheet
   Dim Cl As Range

Application.ScreenUpdating = False
   Set Mws = Sheets("Pcode")
   If Mws.AutoFilterMode Then Mws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      .comparemode = vbTextCompare
      For Each Cl In Mws.Range("C2", Mws.Range("C" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) Then
         .Add Cl.Value, Nothing
         Range("C1").AutoFilter 1, Cl.Value
         Sheets(Cl.Value).UsedRange.Offset(1).ClearContents
         Mws.UsedRange.Offset(1).SpecialCells(xlVisible).Copy Sheets(Cl.Value).Range("A2")
      Next Cl
   End With
   Mws.AutoFilterMode = False
End Sub

 

[JK1111]

Thank you for your reply Cerfani. I tried the cut/paste code. I ran the code and it copied the information over as it should. Then I added another entry to the "main" worksheet, ran the code again and it just added all the entries again, but below the original lines already copied over. So now instead of 433 lines of entry in the line worksheet, I now have 867. The code is still adding to existing information in the client worksheets, but I want it to clear and re-write.

 

[cerfani]

just create the worksheet each time you run the code then...

Private Sub CommandButton1_Click()
    Dim a As Long, b As Long, i As Long, s As Worksheet
    With Worksheets("main") 
        a = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To a
            If .Cells(i, 3).Value = "BA" Then
                'delete old sheet first regardless if it exists
                On Error Resume Next
                Set s = Worksheets("BA")
                On Error Go To 0
                If Not s Is Nothing Then s.Delete

                'now make the sheet again
                Set s = Sheets.Add
                s.Name = "BA"

                'format the sheet however you want
                ...

                b = s.Cells(Rows.Count, 1).End(xlUp).Row
                .Rows(i).Copy s.Cells(b + 1, 1)
            ElseIf .Cells(i, 3).Value = "CS" Then
                ...
            End If
        Next
        Application.CutCopyMode = False
        .Cells(1, 1).Select
    End With
End Sub

something like that, i wrote off the top of my head so not sure if there are typos or errors

 

[Fluff]

@JK1111
Have you tried my suggestion in post#3?

 

[billandrew]

Fluff

very interested to understand how this works....