0

Good morning,

I have this VBA code ready. I needed to know the VBA code to apply it only from sheet 7 (inclusive), can you help me?

Private Sub CommandButton1_Click()
Call adjustList
End Sub

Function saveEntry(x As Integer, y As Integer) As Variant
Dim tmpRows()
Dim i As Integer
Dim e As Integer
Dim numOfRowsForEntry As Integer
Dim numOfColumns As Integer
numOfColumns = 11
Dim tmpColumns() As String
ReDim tmpColumns(numOfColumns)

Cells(x, 1).Select
numOfRowsForEntry = 0
Do Until ActiveCell Like "*Total"
    Cells(x + numOfRowsForEntry, 1).Select
    numOfRowsForEntry = numOfRowsForEntry + 1
Loop

ReDim tmpRows(numOfRowsForEntry - 1)

For i = 0 To UBound(tmpRows) - LBound(tmpRows)
    For e = 0 To numOfColumns
        tmpColumns(e) = ""
        tmpColumns(e) = Cells(x + i, y + e).Text
        Cells(x + i, y + e) = ""
        Cells(x + i, y + e).Interior.Color = xlNone
    Next
    
    tmpRows(i) = tmpColumns
Next

saveEntry = tmpRows
Exit Function
End Function

Sub adjustList()
Dim x As Integer
Dim i As Integer
Dim startRowOfList As Integer
Dim entryList()

Application.ScreenUpdating = False

startRowOfList = 10
NumRows = Cells(Rows.Count, 1).End(xlUp).Row

ReDim Preserve entryList(0)
Cells(startRowOfList, 3).Select

i = 0
For x = startRowOfList To NumRows
    Cells(x, 1).Select
    If Not IsEmpty(ActiveCell) And Not ActiveCell Like "*Total" Then
        entryList(i) = saveEntry(ActiveCell.Row, ActiveCell.Column)
        ReDim Preserve entryList(UBound(entryList) - LBound(entryList) + 
1)
        i = i + 1
    End If
Next

Cells(startRowOfList, 1).Select
For x = 0 To UBound(entryList) - LBound(entryList) - 1
    For i = 0 To UBound(entryList(x)) - LBound(entryList(x))
        If entryList(x)(i)(0) Like "*Total" Then
            ActiveCell.Offset(1, 0) = entryList(x)(i)(0)
            For e = 0 To 11
                ActiveCell.Offset(1, e).Interior.ColorIndex = 15
            Next
        Else
            ActiveCell = entryList(x)(i)(0)
            ActiveCell.Offset(0, 1) = entryList(x)(i)(1)
        End If

        For c = 2 To UBound(entryList(x)(i)) - LBound(entryList(x)(i))
            ActiveCell.Offset(1, c) = entryList(x)(i)(c)
        Next
        
        ActiveCell.Offset(1, 0).Select
    Next
    
    ActiveCell.Offset(1, 0).Select
Next
    
Application.ScreenUpdating = True
End Sub

in addition to this code, I had previously applied a code to format each sheet created from sheet 7 (inclusive). However, with the code above, I don't know how to adjust.

Sub macro()

Const ProcName As String = "macro"
On Error GoTo ClearError

Const FirstWorksheetIndex As Long = 7

Application.ScreenUpdating = False

With ThisWorkbook
    
    Dim LastWorksheetIndex As Long: LastWorksheetIndex = 
.Worksheets.Count
    If LastWorksheetIndex < FirstWorksheetIndex Then Exit Sub
    
    Dim ash As Object: Set ash = .ActiveSheet
    
    Dim n As Long
    
    For n = FirstWorksheetIndex To LastWorksheetIndex
        CreateHeaders .Worksheets(n)
    Next n

    ash.Select

End With

Application.ScreenUpdating = True

ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
    & Err.Number & "':" & vbLf & "    " & Err.Description
Resume ProcExit
End Sub


Sub CreateHeaders(ByVal WS As Worksheet)
Const ProcName As String = "CreateHeaders"
On Error GoTo ClearError

With WS
    
    .Select ' cannot be avoided only because of the following line
    ActiveWindow.DisplayGridlines = False
    
ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
    & Err.Number & "':" & vbLf & "    " & Err.Description
Resume ProcExit
End With
End Sub
Beatriz
  • 93
  • 1
  • 9

1 Answers1

0

To run the method "adjustList" for all sheets you can use the following code in the CommandButton1_Click() method. To run it from sheet 7 you just change the 1 in the for loop to a 7.

Private Sub CommandButton1_Click()
    Dim WS_Count As Integer
    Dim I As Integer
    
    WS_Count = ActiveWorkbook.Worksheets.Count
    
    For I = 1 To WS_Count
        ActiveWorkbook.Worksheets(I).Activate
        Call adjustList
    Next I
End Sub

Function saveEntry(x As Integer, y As Integer) As Variant
    Dim tmpRows()
    Dim i As Integer
    Dim e As Integer
    Dim numOfRowsForEntry As Integer
    Dim numOfColumns As Integer
    numOfColumns = 11
    Dim tmpColumns() As String
    ReDim tmpColumns(numOfColumns)

    Cells(x, 1).Select
    numOfRowsForEntry = 0
    Do Until ActiveCell Like "*Total"
        Cells(x + numOfRowsForEntry, 1).Select
        numOfRowsForEntry = numOfRowsForEntry + 1
    Loop

    ReDim tmpRows(numOfRowsForEntry - 1)

    For i = 0 To UBound(tmpRows) - LBound(tmpRows)
        For e = 0 To numOfColumns
            tmpColumns(e) = ""
            tmpColumns(e) = Cells(x + i, y + e).Text
            Cells(x + i, y + e) = ""
            Cells(x + i, y + e).Interior.Color = xlNone
        Next
        
        tmpRows(i) = tmpColumns
    Next

    saveEntry = tmpRows
    Exit Function
End Function

Sub adjustList()
    Dim x As Integer
    Dim i As Integer
    Dim startRowOfList As Integer
    Dim entryList()

    Application.ScreenUpdating = False

    startRowOfList = 10
    NumRows = Cells(Rows.Count, 1).End(xlUp).Row

    ReDim Preserve entryList(0)
    Cells(startRowOfList, 3).Select

    i = 0
    For x = startRowOfList To NumRows
        Cells(x, 1).Select
        If Not IsEmpty(ActiveCell) And Not ActiveCell Like "*Total" Then
            entryList(i) = saveEntry(ActiveCell.Row, ActiveCell.Column)
            ReDim Preserve entryList(UBound(entryList) - LBound(entryList) + 
    1)
            i = i + 1
        End If
    Next

    Cells(startRowOfList, 1).Select
    For x = 0 To UBound(entryList) - LBound(entryList) - 1
        For i = 0 To UBound(entryList(x)) - LBound(entryList(x))
            If entryList(x)(i)(0) Like "*Total" Then
                ActiveCell.Offset(1, 0) = entryList(x)(i)(0)
                For e = 0 To 11
                    ActiveCell.Offset(1, e).Interior.ColorIndex = 15
                Next
            Else
                ActiveCell = entryList(x)(i)(0)
                ActiveCell.Offset(0, 1) = entryList(x)(i)(1)
            End If

            For c = 2 To UBound(entryList(x)(i)) - LBound(entryList(x)(i))
                ActiveCell.Offset(1, c) = entryList(x)(i)(c)
            Next
            
            ActiveCell.Offset(1, 0).Select
        Next
        
        ActiveCell.Offset(1, 0).Select
    Next
        
    Application.ScreenUpdating = True
End Sub
Nikita Meier
  • 167
  • 1
  • 10
  • Thank you @Nikita! Do I add it to what I already have? Or do I change something? Because the goal would be to embed this code you gave me into the code that adds the formatting to the various pages, since this line-adding formatting is not the only formatting – Beatriz Mar 15 '22 at 11:48
  • You can add the code from my answer to your "CommandButton1_Click()" method for example (instead of the `Call adjustList`). Then it should apply your formatting to all pages. Dont forget to change the loop if you want to start from sheet 7. You can add all your other formatting methods after the line with `Call adjustList` inside the for loop. – Nikita Meier Mar 15 '22 at 11:52
  • I couldn't understand! Can you copy the code you gave me and embed it in the code above, please? @Nikita – Beatriz Mar 15 '22 at 12:28
  • @BeatrizMoreira I adjusted my answer. In line 7 change the 1 to the number of your start sheet. – Nikita Meier Mar 15 '22 at 12:32
  • Cells(x + numOfRowsForEntry, 1).Select --> Line 26 when using the code in my excel always gives error in this line. Does it have to do with the number of columns or rows? @nikita – Beatriz Mar 15 '22 at 14:02
  • What error do you get? – Nikita Meier Mar 15 '22 at 14:06
  • If my answer helped you with your problem please mark it as the accepted answer. – Nikita Meier Mar 21 '22 at 08:41
  • Can you help me with this question I posted @Nikita (https://stackoverflow.com/questions/71574151/how-can-i-record-conditional-data-in-a-list-with-vba-code) ? – Beatriz Mar 22 '22 at 19:41
  • please check my other question: https://stackoverflow.com/questions/71744152/how-to-update-daily-data-in-monthly-data-table-with-vba-code – Beatriz Apr 04 '22 at 22:16