Forum Discussion

gms4b's avatar
gms4b
Brass Contributor
Sep 04, 2019
Solved

help making a loop (to automate table formatting)

I am using excel VBA to automate table formatting. I have 24 tables to automate. I wrote the code with a macro then made some changes. It works fine (it autofills data on A3, E3, and F3, based on the...
Formulas and Functions
Macros and VBA
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Sep 05, 2019

    gms4b 

     

    This should do what you are trying to achieve....

     

    Sub FormatTables()
Dim c   As Long
Dim lr  As Long
Dim i   As Long

Application.ScreenUpdating = False

c = 1

For i = 1 To 24
    lr = Cells(Rows.Count, c + 1).End(xlUp).Row
    If lr > 2 Then
        Cells(3, c).AutoFill Destination:=Range(Cells(3, c), Cells(lr, c))
        Cells(3, c + 4).AutoFill Destination:=Range(Cells(3, c + 4), Cells(lr, c + 4))
        Cells(3, c + 5).AutoFill Destination:=Range(Cells(3, c + 5), Cells(lr, c + 5))
    End If
    c = c + 18
Next i

Application.ScreenUpdating = True
End Sub
Subodh_Tiwari_sktneer's avatar
Subodh_Tiwari_sktneer
Silver Contributor
Sep 05, 2019

gms4b 

 

This should do what you are trying to achieve....

 

Sub FormatTables()
Dim c   As Long
Dim lr  As Long
Dim i   As Long

Application.ScreenUpdating = False

c = 1

For i = 1 To 24
    lr = Cells(Rows.Count, c + 1).End(xlUp).Row
    If lr > 2 Then
        Cells(3, c).AutoFill Destination:=Range(Cells(3, c), Cells(lr, c))
        Cells(3, c + 4).AutoFill Destination:=Range(Cells(3, c + 4), Cells(lr, c + 4))
        Cells(3, c + 5).AutoFill Destination:=Range(Cells(3, c + 5), Cells(lr, c + 5))
    End If
    c = c + 18
Next i

Application.ScreenUpdating = True
End Sub
gms4b's avatar
gms4b
Brass Contributor
Sep 05, 2019

Subodh_Tiwari_sktneer 

 

AMAZING!!! I spent, like, hours yesterday entering all of the cells names in manually...and this does it perfectly! Even better, there are other actions that I need to automate on the same data set as well. I'm hoping that I can just modify this sub and use it in other ways as well.

 

Thank you so much!!!!

 

Greg

  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Sep 05, 2019

    You're welcome Greg! Glad it worked as desired.

    Thanks for the feedback.

     

    Please take a minute to accept my post with the proposed solution as an Answer and hit the like button. 🙂

     

    Subodh

    • gms4b's avatar
      gms4b
      Brass Contributor
      Sep 05, 2019

      Subodh_Tiwari_sktneer 

       

      Haha! I used your sub as a template and this new sub goes back and merges those cells that you did the autofill on. Worked great! 

       

      Actually, instead of 2 subs, I could probably just merge the two subs together...

      Greg

       

      Sub mergecells()

      Dim c As Long
      Dim lr As Long
      Dim i As Long

      Application.ScreenUpdating = False
      Application.DisplayAlerts = False

      c = 1

      For i = 1 To 26
      lr = Cells(Rows.Count, c + 1).End(xlUp).Row
      If lr > 2 Then
      With Sheets("QC Chart 2 Prep")
      .Range(.Cells(3, c), .Cells(lr, c)).Merge
      .Range(.Cells(3, c + 4), .Cells(lr, c + 4)).Merge
      .Range(.Cells(3, c + 5), .Cells(lr, c + 5)).Merge
      End With
      End If
      c = c + 18

      Next i

      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
      End Sub

      • gms4b's avatar
        gms4b
        Brass Contributor
        Sep 05, 2019

        @Subodh_Tiwari_sktneer 

         

        So, I combined those 2 subs together and it works great!

        The last thing I need to do is to move the 26 charts I made I made into a single column. manualy, I do this:

        ------------------------------

        Range("S3:X37").Select
        Selection.Copy
        Range("A38").Select
        ActiveSheet.Paste

        Range("AK3:AP37").Select
        Selection.Copy
        Range("A73").Select
        ActiveSheet.Paste

         

        etc....26 times...

        ------------------------------------

        so, the selected range is S3:X37 (which is .cell(3,19) to .cell(37,24))

        then copy

        and paste into A38 (which is .cell(35,1))

         

        The next chart is Range "AK3:AP37 (which is 18 columns to the right)

        then copy

        and paste into A73 (which is 38 rows down on column A).

         

        however, when I run the sub (below) I get the a compile error (invalid or unqualified reference)! Hopefully its something simple that I'm doing wrong....do you see what that might be?

         

        Thanks,

        Greg

         

        Sub movecharts()

Dim er As Long
Dim ec As Long
Dim sc As Long
Dim i As Long
Dim fr As Long

Application.ScreenUpdating = False

sc = 19
ec = 24
fr = 35

For i = 1 To 26
Range(.Cells(3, sc), .Cells(37, ec)).Select
Selection.Copy
Range(.Cells(fr, 1)).Select
ActiveSheet.Paste

sc = sc + 18
sr = sr + 18
fr = fr + 35

Next i

Application.ScreenUpdating = True
End Sub

         

         

Resources