Trying to Create a Macro to Autoformat a Report

addmaster666 · Mar 14, 2018

Hi All,

I am fairly new to VBA coding however a lot of people at my work rely on me to create useful macros for our office. One of the reports that we pull from our employee portal is absolutely atrocious and I have been tasked with formatting it correctly. So to give you an idea of the data I'm working with, the report pulls as follows (I cannot post an actual picture here due to confidentiality agreements):

col 1 col 2 col 3 - 7 col 7- 11 col 12 - 16 col 17 -21 col 22 - 26
Row 1: [Employee name] [Employee Badge] [Leave of Absence 1] [Leave of Absence 2] [Leave of Absence 3]
Row 2: [Employee name] [Employee Badge] [Leave of Absence 1] [Leave of Absence 2] [Leave of Absence 3] [Leave of Absence 4] [Leave of Absence 5]
Row 3 (etc) repeats

Unfortunately the amount of leaves an employee can take are indefinite and the data changes weekly. I also have over 516 rows to work with, with the current employee with the most leaves at 10.

Here is the code I have Frankensteined together so far to try to pull the data into a more readable format (I have formatted it as a command button so that others can use it with a simple click):

 Private Sub CommandButton1_Click()

Dim lastrow As Long
Dim i As Integer
Dim m As Integer

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

Rows(1).EntireRow.Delete

m = 0

For i = 1 To 20

Sheets("Sheet1").Range(Cells(1, 12), Cells(lastrow - 1, 16)).Copy
Cells(i * lastrow, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Columns(12).EntireColumn.Delete
Columns(12).EntireColumn.Delete
Columns(12).EntireColumn.Delete
Columns(12).EntireColumn.Delete
Columns(12).EntireColumn.Delete

Sheets("Sheet1").Range(Cells(1, 1), Cells((lastrow - 1, 6)).Copy

Cells(i * lastrow, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

m = -1

Next i

End Sub

So, first off, pretend that the example I gave above actually aligns with the proper ranges in my VBA code. What this code does (kind of) is pull leaves of absence 2 through 10 and places them below the leave of absence 1 columns. It also takes all of the employee names and continuously copies them down the left side of my worksheet so that they align with their associated leaves. The issue I am running into is that for every iteration of the variable "I" the pasted data creates blank rows between the copy and pasted data so it looks something like this:

[Bob Test] [medical leave number 1]
BLANK BLANK
[Bob Test] [medical leave number 2]

So I know I am going to have some more coding to do to condense the blank rows that this code will create (it copies and pastes all the employees names regardless of whether there is an associated leave in the next row or not) but I was wondring if someone could at least help me figure out why these blanks are being created. Maybe someone can suggest a much easier way to format this data?

I apologize, I know this information may be near incomprehensible. I have been working on it for two weeks now and it has become quite a nightmare.....my boss is also asking why its taking so long.

Please help!

Fazza · Mar 15, 2018

there are many ways, here is one, please back up your file BEFORE running the code

Code:

Sub one_way()

    Dim i As Long, j As Long, k As Long
    
    Dim arIn As Variant
    Dim arOut As Variant
    
    'Assumes active sheet at start of code execution is the one with the data
    arIn = ActiveSheet.UsedRange.Value 'load data into array
    ReDim arOut(1 To 1000, 1 To 3)
    
    For i = LBound(arIn, 1) To UBound(arIn, 1) 'loop through each row of data
        For j = 3 To UBound(arIn, 2) 'loop through each column of data, from column 3
    
            'if there is a value in the input column j, create an output record
            If Len(arIn(i, j)) > 0 Then
                k = k + 1
                arOut(k, 1) = arIn(i, 1) 'Name in column 1
                arOut(k, 2) = arIn(i, 2) 'Badge info in column 2
                arOut(k, 3) = arIn(i, j) 'leave data in column 3
            Else
                Exit For 'if no data, stop looping the columns for this row
            End If
    
        Next j
    Next i
    
    Cells.Clear
    Range("A1").Resize(k, 3).Value = arOut


End Sub

Fazza · Mar 15, 2018

for large data sets the array dimension will be inadequate. please change the line
ReDim arOut(1 to 1000, 1 to 3)
to
ReDim arOut(1 to 60000, 1 to 3)

addmaster666 · Mar 15, 2018

Fazza said:

there are many ways, here is one, please back up your file BEFORE running the code

Code:

Sub one_way()

    Dim i As Long, j As Long, k As Long
    
    Dim arIn As Variant
    Dim arOut As Variant
    
    'Assumes active sheet at start of code execution is the one with the data
    arIn = ActiveSheet.UsedRange.Value 'load data into array
    ReDim arOut(1 To 1000, 1 To 3)
    
    For i = LBound(arIn, 1) To UBound(arIn, 1) 'loop through each row of data
        For j = 3 To UBound(arIn, 2) 'loop through each column of data, from column 3
    
            'if there is a value in the input column j, create an output record
            If Len(arIn(i, j)) > 0 Then
                k = k + 1
                arOut(k, 1) = arIn(i, 1) 'Name in column 1
                arOut(k, 2) = arIn(i, 2) 'Badge info in column 2
                arOut(k, 3) = arIn(i, j) 'leave data in column 3
            Else
                Exit For 'if no data, stop looping the columns for this row
            End If
    
        Next j
    Next i
    
    Cells.Clear
    Range("A1").Resize(k, 3).Value = arOut


End Sub

Wow! This is extremely impressive code. To be honest I haven't really gotten into Arrays so much yet but this is perfect. There's one issue though that I am now hoping you can help me with (although I will choose your answer as the best response regardless since you've shown me such an awesome new trick). This code sorts the data into column 1 and column 2 replicating the employee name and badge number and the first section of their leave data. So now that this part has been worked out, I have to explain that each section of leave of absence data is actually split into 5 different columns. So the code actually looks more like this:

Employee Data Leave of Absence One Leave of Absence Two Leave of Absence Three
[Emp Name] [Emp Badge] [1][2][3][4][5] [1][2][3][4][5] [1][2][3][4][5]

I need the data to pull as follows:
col 1 - 2 col 3 - 7
Row 1: Employee Data leave of absence One
Row 2: Employee Data leave of absence Two
Row 3: Employee Data leave of absence Three

Hoping you can help me out with this final piece. Either way thanks for your response.

addmaster666 · Mar 15, 2018

addmaster666 said:
Wow! This is extremely impressive code. To be honest I haven't really gotten into Arrays so much yet but this is perfect. There's one issue though that I am now hoping you can help me with (although I will choose your answer as the best response regardless since you've shown me such an awesome new trick). This code sorts the data into column 1 and column 2 replicating the employee name and badge number and the first section of their leave data. So now that this part has been worked out, I have to explain that each section of leave of absence data is actually split into 5 different columns. So the code actually looks more like this:

Employee Data Leave of Absence One Leave of Absence Two Leave of Absence Three
[Emp Name] [Emp Badge] [1][2][3][4][5] [1][2][3][4][5] [1][2][3][4][5]

I need the data to pull as follows:
col 1 - 2 col 3 - 7
Row 1: Employee Data leave of absence One
Row 2: Employee Data leave of absence Two
Row 3: Employee Data leave of absence Three

Hoping you can help me out with this final piece. Either way thanks for your response.

Sorry, to explain the train wreck above a bit further. I need the data to pull the leaves of absence (which are all in the same row) into separate rows with the employees name and badge at the front.

So, if Bob Test has 3 leaves of absence in his "row" as follows:

Bob Test - badge - LOA 1 - LOA 2 - LOA 3

I need it to pull like this:

Bob Test - badge - LOA 1
Bob Test - badge - LOA 2
Bob Test - badge - LOA 3

The issue becomes that each LOA has 5 cells of data so I need the code to recognize those 5 cells as LOA "blocks" which I need to be pulled into the same row

Fluff · Mar 15, 2018

Cross posted https://www.excelforum.com/excel-pr...e-code-is-not-doing-what-i-need-it-to-do.html

Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

Fazza · Mar 15, 2018

wrt cross posting, you might find many people will ignore posts where cross posting is called out. so please remember to identify any cross posting up front to avoid limiting the audience

Code:

Sub one_way()    
    Const lCOLUMNS_OF_LEAVE_DATA As Long = 5 ' After the first 2 columns, data is in blocks of 5 columns
    
    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim arIn As Variant
    Dim arOut As Variant
    
    'Assumes active sheet at start of code execution is the one with the data
    arIn = ActiveSheet.UsedRange.Value 'load data into array
    ReDim arOut(1 To 60000, 1 To lCOLUMNS_OF_LEAVE_DATA + 2)
    
    For i = LBound(arIn, 1) To UBound(arIn, 1) 'loop through each row of data
        For j = 3 To UBound(arIn, 2) Step lCOLUMNS_OF_LEAVE_DATA 'loop through each lot of columns of data, from column 3
            For m = 1 To lCOLUMNS_OF_LEAVE_DATA 'check if there is an entry anywhere in this block of columns
                If Len(arIn(i, j + m - 1)) > 0 Then
                    k = k + 1 'output data array will be populated in row k
                    arOut(k, 1) = arIn(i, 1) 'Name in column 1
                    arOut(k, 2) = arIn(i, 2) 'Badge info in column 2
                    For n = 1 To lCOLUMNS_OF_LEAVE_DATA 'leave data from block of columns
                        arOut(k, 3 + n - 1) = arIn(i, j + n - 1)
                    Next n
                    Exit For 'Done with this "m" block. Will then go to the next "j" loop
                End If
            Next m
        Next j
    Next i
    
    Cells.Clear
    Range("A1").Resize(k, UBound(arOut, 2)).Value = arOut
    
End Sub

Fazza · Mar 16, 2018

Added a Const for the number of fixed/repeating columns on LHS. Value 2

Code:

Sub one_way() 'Assumes active sheet at start of code execution is the one with the data

    Const lCOLUMNS_ON_LHS_TO_REPEAT As Long = 2 'LHS 2 columns are common to all output records
    Const lCOLUMNS_OF_LEAVE_DATA As Long = 5 'After the LHS columns, data is in blocks of 5 columns
    
    Dim i As Long, j As Long, k As Long, m As Long, n As Long, p As Long
    Dim arIn As Variant
    Dim arOut As Variant
    
    arIn = ActiveSheet.UsedRange.Value 'load data into array
    ReDim arOut(1 To 60000, 1 To lCOLUMNS_ON_LHS_TO_REPEAT + lCOLUMNS_OF_LEAVE_DATA)
    
    For i = LBound(arIn, 1) To UBound(arIn, 1) 'loop through each row of data
        For j = lCOLUMNS_ON_LHS_TO_REPEAT + 1 To UBound(arIn, 2) Step lCOLUMNS_OF_LEAVE_DATA 'loop through each lot of columns of data
            For m = 1 To lCOLUMNS_OF_LEAVE_DATA 'check if there is an entry anywhere in this block of columns
                If Len(arIn(i, j + m - 1)) > 0 Then
                    k = k + 1 'output data array will be populated in row k
                    For n = 1 To lCOLUMNS_ON_LHS_TO_REPEAT 'Common data from leading columns
                        arOut(k, n) = arIn(i, n)
                    Next n
                    For p = 1 To lCOLUMNS_OF_LEAVE_DATA 'leave data from block of columns
                        arOut(k, lCOLUMNS_ON_LHS_TO_REPEAT + p) = arIn(i, j + p - 1)
                    Next p
                    Exit For 'Done with this "m" block. Will then go to the next "j" loop
                End If
            Next m
        Next j
    Next i
    
    Cells.Clear
    Range("A1").Resize(k, UBound(arOut, 2)).Value = arOut
End Sub

Trying to Create a Macro to Autoformat a Report

addmaster666

New Member

Excel Facts

Fazza

MrExcel MVP

Fazza

MrExcel MVP

addmaster666

New Member

addmaster666

New Member

Fluff

MrExcel MVP, Moderator

Fazza

MrExcel MVP

Fazza

MrExcel MVP

Similar threads

Forum statistics

Share this page

Trying to Create a Macro to Autoformat a Report

New Member

Excel Facts

MrExcel MVP

MrExcel MVP

New Member

New Member

MrExcel MVP, Moderator

MrExcel MVP

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock