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
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

       

       

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

        gms4b 

         

        The problem is with the following two lines...

        1. Range(.Cells(3, sc), .Cells(37, ec)).Select

        2. Range(.Cells(fr, 1)).Select

         

        In the first line you are using . (period) before the Cells which is used when you specify the parent object in a WITH and END WITH block so it is not required here and you should remove the period from both the occurrences of Cells in that line. Also, you don't need to use Select in order to copy a range so you can replace Select with Copy.

         

        In second line Range object expects a cell address not the cell object itself so use of Range in that line doesn't make any sense, you can use only Cells(fr, 1).Select and that will work as desired.

         

        Please try it like this...

         

        Sub movecharts()
Dim sr As Long
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)).Copy
    Cells(fr, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = 0

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

Next i

Application.ScreenUpdating = True
End Sub

Resources