Can you save me hours of work??

zookeepertx

zookeepertx

Well-known Member
Joined
May 27, 2011
Messages
589
Office Version
  1. 365
Platform
  1. Windows
I’m working with Excel 2003 (I know, I know. But it’s my work computer, so I’m stuck with it). I’m hoping to save myself several hours of mind-numbing work a couple of times a month, setting up a spreadsheet. Let me mention that I do not “speak” technical-speak; I can generally get done what I want to do, but I have a lot of trouble expressing it (or comprehending it) verbally, so please, bear with me.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
What I have is a spreadsheet that’s 40 columns wide; the first 20 columns are last month’s data (LM) and the next 20 are this month’s data (TM). The number of rows varies every month – anywhere up to 1,100-1,200 rows. The first 3 columns on each side consist of a File #, File Age and Vendor/Company/Department. I have to go through & compare the 2 sides, row by row, looking at the File # and Ven/Co/Dpt. I did Text-To-Columns on the Ven/Co/Dept column to separate out the parts. So, first I need to compare the File # from LM to TM. If they match, then I compare the Ven #s. If those also match, then I compare the Dept #s. (The Co portion is actually irrelevant, by itself). If all 3 columns match exactly, then it’s all good. If either side has a row that the other side doesn’t have, I have to insert a row in all 20 columns of the other side – basically a “place-holder”. The inserted row will only contain the File # and Ven/Co/Dept, but no other data.
<o:p></o:p>
When done, both sides of the spreadsheet contain the same number of rows. When a row is inserted, it doesn’t HAVE to get the File-Ven/Co/Dept plugged in, since I’ll have to go back & format things further, anyway. However, I would be in heaven if I didn’t have to go blind spending several hours shoring up all those rows.
<o:p></o:p>
Has anybody got any ideas for a macro or something that would help me? One possible problem I thought of is that, once a row has been inserted, moving that side of the data down a row, that’s going to throw off a formula, isn’t it? Unless there’s some way to make the solution look at only 1 row at a time, not moving on until each adjustment has been made.
<o:p></o:p>
I know I’ve probably been very confusing, but if I could figure out how to post either a portion of the spreadsheet or a screenshot of it, it’d probably make more sense.
<o:p></o:p>
Anyway, I appreciate any help I can get! A co-worker & I have been tossing this around for several months & haven’t come up with a workable solution. Maybe one of you can save me!
 
Sort by date Sort by votes
Ahh, it's ok then :P
I'll just figure it out blindfoldedly, haha.
I'm actually learning alot myself from doing this so hopefully I can get it right the first try!
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
I forgot to ask you this:
In your columnA and columnR, is there any blank cells except for at the very end?
 
Upvote 0
I just checked with our IT guy about the excel-jeanie link & I'm NOT allowed to use that. Too bad you can't just build a table on here in a post; I'd do that.

No, no blanks in A or R until the end. I always make sure there's a blank line between the data & the total row, though. But there's no File or Ven/Co/Dept on the total row.

I always learn stuff when I'm muddling through things, too. But this one just kicked my backside.
 
Upvote 0
I always make sure there's a blank line between the data & the total row
Click to expand...

I'm not sure I folllow what you mean by that.
But as long as there's absolutely no blank cell in ColumnA and columnR then the code should run fine at this developing stage :P
 
Upvote 0
kpark91 said:
I'm not sure I folllow what you mean by that.
But as long as there's absolutely no blank cell in ColumnA and columnR then the code should run fine at this developing stage :P
Click to expand...

Oh, it's just that I leave an empty row at the bottom of the data, in case I might need to insert a new row or something. That way it doesn't change the border at the bottom or anything. Kind of a "buffer zone".
 
Upvote 0
Well, I need to go so...

I'll leave the code on this forum but it's nowhere near to being completed but
someone may just pick it up and resume the work :P
(leaving the most important part but left comments on the algorithm I want to perform or at least attempted haha)

I'll be back... in like 10 hours lol
Code: 
Sub kpark91May272011()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Dim newWS1 As Worksheet, newWS2 As Worksheet, LR1 As Double, LR2 As Double, dataWS As String
 
    Set newWS1 = Worksheets.Add(, Sheets(Sheets.count))
    Set newWS2 = Worksheets.Add(, Sheets(Sheets.count)) 'Add Worksheet At the end of the workbook temporarily
 
    dataWS = InputBox("What is your data worksheet's name? (Case-sensitive)")
 
    LR1 = Worksheets(dataWS).Range("A" & Rows.count).End(xlUp).Row
    LR2 = Worksheets(dataWS).Range("R" & Rows.count).End(xlUp).Row 'Find row # before the first occurrence of a blank cell in the column
 
    'Copy the data into two separate files
    With Worksheets(dataWS)
        .Range("A8:Q" & LR1).Copy newWS1.Cells(1, 1) 'Copy + Paste PM's data into first temp sheet
        .Range("R8:AH" & LR2).Copy newWS2.Cells(1, 1) 'Copy + Paste TM's data into second temp sheet
    End With
 
    'Sort colC, colB, then colA of newWS1
    With newWS1
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 1), .Cells(LR1, 1)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 2), .Cells(LR1, 2)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 3), .Cells(LR1, 3)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:Q" & LR1)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
 
    'Sort colC, colB, then colA of newWS2
    With newWS2
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 1), .Cells(LR1, 1)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 2), .Cells(LR1, 2)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 3), .Cells(LR1, 3)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:Q" & LR2)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
 
    'Loop through both new worksheets at the same time
    'Since they are sorted from A to Z, whatever has the bigger value in the same row number as the other worksheet,
    'there will be a new line added above it with the values from the smaller values copied as requested
    'however, if there is comparison between a blank cell and  0, it will be considered as equal, which may cause some problems
 
    Dim nRow As Double
    nRow = 1 'Data starts from row 8
 
 
 
 
 
    'Delete temporary worksheets
    'Application.DisplayAlerts = False
    'newWS1.Delete
    'newWS2.Delete
    'Application.DisplayAlerts = True
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
 
Upvote 0
AACCKKK! That's a LOT! I'm thinking I could have spent the rest of my life & never figured this out! I bow to your superior brain cells! :pray:
(Can't wait to see it completed!)
 
Upvote 0
Hello, here is the code you can use:

Remember to make a copy of your workbook before running the given macro or you will lose all of your original data (if there is any error)

I wasn't sure where you needed the balanced table of data so I've just created another worksheet for the balanced one.

I have a variable called "dataStartRow" and you are able to change the value so that you can deal with any other data that starts on a different line.

I have a variable called "dataWS" which is a string (combination of characters) which signifies the name of the worksheet. In order to not get an inputbox everytime you could just replace this line of code:
Code: 
dataWS = InputBox("What is your data worksheet's name? (Case-sensitive)")

with
Code: 
dataWS = "Sheet1"

Assumptions:
- in colA, ColR, there are no empty cells in the middle of the data.
- your data spans from colA until colAH where colR is the start of your second set of data

Code: 
Sub kpark91May272011()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    Dim newWS1 As Worksheet, newWS2 As Worksheet, LR1 As Double, LR2 As Double, dataWS As String
    Dim dataStartRow As Double, balWS As Worksheet
    
    dataStartRow = 8 'Data starting row
    
    dataWS = InputBox("What is your data worksheet's name? (Case-sensitive)")
    On Error GoTo 0
    Set newWS1 = Worksheets.Add(, Sheets(Sheets.count))
    Set newWS2 = Worksheets.Add(, Sheets(Sheets.count)) 'Add Worksheet At the end of the workbook temporarily
    
    LR1 = Worksheets(dataWS).Range("A" & Rows.count).End(xlUp).Row
    LR2 = Worksheets(dataWS).Range("R" & Rows.count).End(xlUp).Row 'Find row # before the first occurrence of a blank cell in the column
    
    'Copy the data into two separate files
    With Worksheets(dataWS)
        .Range("A" & dataStartRow & ":Q" & LR1).Copy newWS1.Cells(1, 1) 'Copy + Paste PM's data into first temp sheet
        .Range("R" & dataStartRow & ":AH" & LR2).Copy newWS2.Cells(1, 1) 'Copy + Paste TM's data into second temp sheet
    End With
    
    'Sort colC, colB, then colA of newWS1
    With newWS1
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 1), .Cells(LR1, 1)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 2), .Cells(LR1, 2)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 3), .Cells(LR1, 3)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:Q" & LR1)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
    'Sort colC, colB, then colA of newWS2
    With newWS2
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 1), .Cells(LR1, 1)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 2), .Cells(LR1, 2)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range(.Cells(1, 3), .Cells(LR1, 3)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:Q" & LR2)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
    'Loop through both new temporary worksheets at the same time
    'Since they are sorted from A to Z, whatever has the bigger value in the same row number as the other worksheet,
    'there will be a new line added above it with the values from the smaller values copied as requested
    'however, if there is comparison between a blank cell and  0, it will be considered as equal, which may cause some problems
    
    Dim nRow As Double
    nRow = 1 'Data starts from row 1 of temporary files
    
    '''Balancing based on three criteria
    Do While Not IsEmpty(newWS1.Cells(nRow, 1).Value) Or Not IsEmpty(newWS2.Cells(nRow, 1).Value)
        If newWS1.Cells(nRow, 1).Value > newWS2.Cells(nRow, 1).Value And newWS2.Cells(nRow, 1).Value <> "" Then
            If newWS2.Cells(nRow, 1).Value <> "" Then
                newWS1.Cells(nRow, 1).EntireRow.Insert
                newWS1.Cells(nRow, 1).Value = newWS2.Cells(nRow, 1).Value
                newWS1.Cells(nRow, 2).Value = newWS2.Cells(nRow, 2).Value
                newWS1.Cells(nRow, 3).Value = newWS2.Cells(nRow, 3).Value
            Else
                newWS2.Cells(nRow, 1).Value = newWS1.Cells(nRow, 1).Value
                newWS2.Cells(nRow, 2).Value = newWS1.Cells(nRow, 2).Value
                newWS2.Cells(nRow, 3).Value = newWS1.Cells(nRow, 3).Value
            End If
        ElseIf newWS1.Cells(nRow, 1).Value < newWS2.Cells(nRow, 1).Value Then
            If newWS1.Cells(nRow, 1).Value <> "" Then
                newWS2.Cells(nRow, 1).EntireRow.Insert
                newWS2.Cells(nRow, 1).Value = newWS1.Cells(nRow, 1).Value
                newWS2.Cells(nRow, 2).Value = newWS1.Cells(nRow, 2).Value
                newWS2.Cells(nRow, 3).Value = newWS1.Cells(nRow, 3).Value
            Else
                newWS1.Cells(nRow, 1).Value = newWS2.Cells(nRow, 1).Value
                newWS1.Cells(nRow, 2).Value = newWS2.Cells(nRow, 2).Value
                newWS1.Cells(nRow, 3).Value = newWS2.Cells(nRow, 3).Value
            End If
        Else
            If newWS1.Cells(nRow, 2).Value > newWS2.Cells(nRow, 2).Value And newWS2.Cells(nRow, 2).Value <> "" Then
                If newWS2.Cells(nRow, 2).Value <> "" Then
                    newWS1.Cells(nRow, 2).EntireRow.Insert
                    newWS1.Cells(nRow, 1).Value = newWS2.Cells(nRow, 1).Value
                    newWS1.Cells(nRow, 2).Value = newWS2.Cells(nRow, 2).Value
                    newWS1.Cells(nRow, 3).Value = newWS2.Cells(nRow, 3).Value
                Else
                    newWS2.Cells(nRow, 1).Value = newWS1.Cells(nRow, 1).Value
                    newWS2.Cells(nRow, 2).Value = newWS1.Cells(nRow, 2).Value
                    newWS2.Cells(nRow, 3).Value = newWS1.Cells(nRow, 3).Value
                End If
            ElseIf newWS1.Cells(nRow, 2).Value < newWS2.Cells(nRow, 2).Value Then
                If newWS1.Cells(nRow, 2).Value <> "" Then
                    newWS2.Cells(nRow, 2).EntireRow.Insert
                    newWS2.Cells(nRow, 1).Value = newWS1.Cells(nRow, 1).Value
                    newWS2.Cells(nRow, 2).Value = newWS1.Cells(nRow, 2).Value
                    newWS2.Cells(nRow, 3).Value = newWS1.Cells(nRow, 3).Value
                Else
                    newWS1.Cells(nRow, 1).Value = newWS2.Cells(nRow, 1).Value
                    newWS1.Cells(nRow, 2).Value = newWS2.Cells(nRow, 2).Value
                    newWS1.Cells(nRow, 3).Value = newWS2.Cells(nRow, 3).Value
                End If
            Else
                If newWS1.Cells(nRow, 3).Value > newWS2.Cells(nRow, 3).Value Then
                    If newWS2.Cells(nRow, 3).Value <> "" Then
                        newWS1.Cells(nRow, 3).EntireRow.Insert
                        newWS1.Cells(nRow, 1).Value = newWS2.Cells(nRow, 1).Value
                        newWS1.Cells(nRow, 2).Value = newWS2.Cells(nRow, 2).Value
                        newWS1.Cells(nRow, 3).Value = newWS2.Cells(nRow, 3).Value
                    Else
                        newWS2.Cells(nRow, 1).Value = newWS1.Cells(nRow, 1).Value
                        newWS2.Cells(nRow, 2).Value = newWS1.Cells(nRow, 2).Value
                        newWS2.Cells(nRow, 3).Value = newWS1.Cells(nRow, 3).Value
                    End If
                ElseIf newWS1.Cells(nRow, 3).Value < newWS2.Cells(nRow, 3).Value Then
                    If newWS1.Cells(nRow, 3).Value <> "" Then
                        newWS2.Cells(nRow, 3).EntireRow.Insert
                        newWS2.Cells(nRow, 1).Value = newWS1.Cells(nRow, 1).Value
                        newWS2.Cells(nRow, 2).Value = newWS1.Cells(nRow, 2).Value
                        newWS2.Cells(nRow, 3).Value = newWS1.Cells(nRow, 3).Value
                    Else
                        newWS1.Cells(nRow, 1).Value = newWS2.Cells(nRow, 1).Value
                        newWS1.Cells(nRow, 2).Value = newWS2.Cells(nRow, 2).Value
                        newWS1.Cells(nRow, 3).Value = newWS2.Cells(nRow, 3).Value
                    End If
                End If
            End If
        End If
        nRow = nRow + 1
    Loop
    
    
    Set balWS = Worksheets.Add(, Sheets(Sheets.count)) 'Create a worksheet that is balanced
    
    'Copy onto new dataworksheet
    Worksheets(dataWS).Range("A1:AH7").Copy balWS.Range("A1")
    newWS1.Range("A1:Q" & nRow).Copy balWS.Range("A8")
    newWS2.Range("A1:Q" & nRow).Copy balWS.Range("R8")
    
    'Delete temporary worksheets
    newWS1.Delete
    newWS2.Delete
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With
End Sub

Remember to make a copy of your workbook before running the given macro or you will lose all of your original data (if there is any error)
 
Upvote 0
Hi again!

I'm off work today, but thought I'd try & play with this at home. (No, I DON'T have a life, LOL!) I made a short - 20-30 row - sheet & pasted the code into a module in VBE and went to run it. But it gave me an error message that said "Compile Error: Method or data member not found." and the .Sort part was highlighted in the code at -

'Sort colC, colB, then colA of newWS1
With newWS1
.Sort.SortFields.Clear

Don't know what I'm doing wrong...

Also, I have no clue what this means:
I have a variable called "dataStartRow" and you are able to change the value so that you can deal with any other data that starts on a different line.

I have a variable called "dataWS" which is a string (combination of characters) which signifies the name of the worksheet. In order to not get an inputbox everytime you could just replace this line of code:
Click to expand...
I'm a dunce. :confused:
 
Upvote 0
Hello, the code should be pasted onto your "ThisWorkbook"

and.. what version of XL are you using?
(Note: This code worked on my worksheet in XL2007)

As for the quote you didn't understand.
I was just saying that in the code, there is a line:
Code: 
dataStartRow = 8
which specifies where your data starts.. (you've said the data starts at 8th line)

So, if your data starts at 7th line by any chance
you can edit the code to
Code: 
dataStartRow = 7
by just replacing the number.

Also, dataWS stands for dataWorkSheet. and I've made it so that it calls an inputbox where you'll be required to input a name of the worksheet but it will be tedious if you type the every single time you run.
So, if the worksheet name where you're getting the data from is constant or not changing, you could just fix this part of the code.
If you wanted "Sheet1" to be your data sheet everytime, you can just replace this
Code: 
dataWS = InputBox("What is your data worksheet's name? (Case-sensitive)")
with
Code: 
dataWS = "Sheet1"
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Insert Cells into Defined Range in middle of sheet surrounded with data
Replies
1
Views
178
sijpie
sijpie
U
  • Question Question
Inserting images into Excel workbook - loss of image quality problem
Replies
1
Views
445
ranman256
ranman256
X
  • Question Question
VBA for extracting specific data from PDF Docs
Replies
3
Views
728
xcellrodeo
X
S
  • Solved
When Filter is applied, Excel jumps down multiple rows to (Blanks). How can Filter ignore blanks?
Replies
3
Views
410
Peter_SSs
Peter_SSs
G
  • Question Question
V/Hlookup or Index/Match assistance Required?
Replies
7
Views
101
etaf
etaf

Forum statistics

Threads
1,224,574
Messages
6,179,628
Members
452,933
Latest member
patv

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top