Need Help Cleaning\Consolidate VBA and a Bug Fix + add a color to rows based on data

robertwp7472 · Aug 27, 2016

Hello, I have used this forum before with great success and thanks goes out to all that helped , especially NoS.

I am working on a new project and I am a Novice at writing VBA. I can kind of read it due to previous Visual Basic experience but I am still learning to write it.

For this project I utilized the Macro Recorder for a chunk of it and I borrowed code from my previous project and adapted it to the best of my ability. What I need is for the code to be looked at since the Macro Recorder uses inefficient Code and get some help cleaning it up and debugging. Also, I have a SUB that retrieves data from another file. It works but it opens in a second tab and I need it to transfer the data to the first tab instead and at Row 2 instead of Row 1 because I have command buttons in Row 1.

Note: This file is a daily upload from SAP and is of random length depending upon how many orders we have so any code written or rewritten needs to account for this. (Please see attachments)

View attachment Best Door.xlsm View attachment Allocation Query.xlsx

For the colorizing....

If the above runs completely then there will be a Column named "Isle" that has data like "AA, AY, PG, BD, etc." What I'd like to have happen is the entire row be colorized using a five color range of Light Pink, Light Blue, Light Green, Light Yellow, & Light Grey depended upon the value of Column "Isle"

If the value is between (AA:AK) then Pink, (AL:AY) Blue, (BA:BF) Green, (BG:BT) Yellow, (CA:CE) grey, & (PA

M) no color

I also need a function run that I can't figure out in VBA. One of the Columns is named "Slot" and it has numerical data in it. What I need is for this to work: IF value of "Slot" < 63 Then K="North" Else K="South"

The final function will be to sort the form by Column A "Order Number"

Any help provided will be greatly appreciated. Thanks

NoS · Aug 27, 2016

You need to get what you've got to work before trying to do more.

Your ClearAll procedure can be reduced to two words --> Cells.Delete
and if you set the height of row 1 at the same time you won't need to deal any more with row 1.
The frozen panes will remain and not need to be addressed either.

Code:

Sub ClearAll1()
    Cells.Delete
    Rows(1).RowHeight = 45
End Sub

The MoveSheet macro is faulting because moving the sheet leaves a workbook with no sheets in it which Excel does not allow.
change .Move to .Copy

It's seldom necessary to select any thing. Things like

Code:

    Columns("B:B").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight

can be

Code:

    Columns("B:B").Cut
    Columns("G:G").Insert Shift:=xlToRight

I recommend using Option Explicit, (Google if necessary) and not running macros from buttons when testing.

Open your workbook and hit the Windows key + left arrow, the spreadsheet will fill the left half of your screen.
ALT+F11 to bring up the VBA environment, Windows key + right arrow, the VBE now fills the right half of your screen.
Put the cursor within the macro you want to run and use the F8 key to step through one line at a time. You'll see both what the macro is doing and what's happening on the spreadsheet at the same time. You'll be able to see what the PickCount1 procedure doesn't do and will figure out why.

Have a go with this.
When you get your data on Allocation Query (2) the way it should be come back and we'll move on from there.

PS: seeing you don't use the original column A (Item), you may as well delete it when deleting the others. I don't see any reason to relocate it to column C, insert a new column D, split it into C and D, delete column D and then in the next procedure delete column C without ever using it.

robertwp7472 · Aug 28, 2016

I am now making use of Option Explicit and I can definitely see its benefit. I am currently working with the "MoveSheet" sub trying to get it to function as needed. I made the suggested change of using.copy instead of .move and that seems to work however, it opens another window of excel that I then have to minimize to get out of my way and populates a second tab on the workbook which I ten had to get to copy over to the first tab. Shouldn't there be a way, as with the other project, for it to directly populate into the first tab form at row 2?

here is what I have:

Code:

Sub MoveSheet()

Application.ScreenUpdating = False
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wb2Loc As String
Dim ws2 As Worksheet
Dim ws2Name As String

wb2Loc = "C:\Users\Family\My Documents\Dads\Work\Best Door\Allocation Query.xlsx"
'Change above to your target workbook name

ws2Name = "Allocation Query"
'Change above to the sheet name you want to copy over

Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open(Filename:=wb2Loc)
Set ws2 = wb2.Sheets(ws2Name)
ws2.Copy after:=wb1.Sheets(wb1.Sheets.Count)
wb2.Close False


' Copies Data from second tab

    Sheets("Allocation Query (2)").Select
    Rows("1:3000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Allocation Query").Select
    Range("A2").Select
    ActiveSheet.Paste

' Here it pops up a warning box about deleting the sheet which should just be automatic 
    
    Sheets("Allocation Query (2)").Select
    ActiveWindow.SelectedSheets.Delete
    
    Application.ScreenUpdating = True

End Sub

I know I am missing something really simple. Also, I agree with your PS statement. I will make that change as well.

NoS · Aug 28, 2016

I don't understand the 'opens another window' part, for me it just copies the sheet into the "Best Door" workbook and closes "Allocation Query.xlsx".

Don't worry about getting things onto the first sheet until after you've done everything on the second sheet.
It's easy to do a usedrange.copy to A2, then delete the second sheet.

Maneuvering the columns doesn't need to be that complicated either.
You can copy the column that's to be first to say column AA, second to AB, third to AC,
next 2 would be blank for splitting up that third column,
next to AF, etc., then delete columns A:Z.

NoS · Aug 28, 2016

Here it pops up a warning box about deleting the sheet which should just be automatic

Google is your friend.

The final function will be to sort the form by Column A "Order Number"

Your code, and comments in the code, have column A being "Order Type."
What is the desired column order ?

What is the RGB or color index you intend to use for each color?

robertwp7472 · Aug 29, 2016

I think what is happening which prompted the

Opens a new window

is that it is actually opening Allocation Query.xlsx in a secondary window rather than just running behind the scenes and then closing. I don't know why. I am not even sure why its populating a second tab that then has to be deleted. Could this be an Excel 2016 thing?

Thanks for the Google link. Would this be the correct syntax for that?

Code:

[COLOR=#008000]' Here it pops up a warning box about deleting the sheet which should just be automatic[/COLOR]      
 
Application.DisplayAlerts = [COLOR=#000080]False
[/COLOR]
Sheets("Allocation Query (2)").Select     
ActiveWindow.SelectedSheets.Delete
    
Application.DisplayAlerts = [COLOR=#000080]True[/COLOR] 

Application.ScreenUpdating = True

----------------------------------------------
I am beginning to see the detriment to using "Macro Recorder", it works but it does it in such a round about way that it is nearly impossible for a novice like me to gleam any usable code.

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

Your code, and comments in the code, have column A being "Order Type."
What is the desired column order ?

From the original "Raw" Allocation Query.xlsx

Step 1 = Delete A, B, C, D, E, F, G, I, J, M, P

Step 2 = Move A (Conversion Factor) to G, & E (Pick Unit) to H

Step 3 = Split/Parse D (Source Location) The Current format = 1AA020C what is needed is two columns; one called "Isle" with only the AA portion and the other called "Slot" with only the 020 portion. The " 1 " & the "C" can be removed.

Step 4 = create new column (which would now be in H after above) called Pick Count. Data in Pick Count comes from a calculation of "Released / Conversion Factor" but only IF Pick Unit = "PAL", IF Pick Unit <> "PAL" THEN Pick Count = Concatenation of "Released and Pick Unit".

Final Order = Order#, Order Type, Isle, Slot, Released, Conversion Factor, Pick Unit, Pick Count

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

What is the RGB or color index you intend to use for each color?

Pink = 16769535
Green = 13434828
Blue = 16772300
Yellow = 13434879
Grey = 14540253

NoS · Aug 29, 2016

it is actually opening Allocation Query.xlsx in a secondary window rather than just running behind the scenes and then closing.

That is what's happening. Once in use you won't notice.

I am not even sure why its populating a second tab

Because the sheet is being copied from one workbook to the other. In your original post you were trying to move the sheet from one to the other, I suggested copy to eliminate the error of ending up with a workbook with no sheets.
If the second sheet is a problem for you then copy just the data and paste it where you want or need it (A2), and go from there.

From the original "Raw" Allocation Query.xlsx

Step 1 = Delete A, B, C, D, E, F, G, I, J, M, P

Step 2 = Move A (Conversion Factor) to G, & E (Pick Unit) to H

Step 3 = Split/Parse D (Source Location) The Current format = 1AA020C what is needed is two columns; one called "Isle" with only the AA portion and the other called "Slot" with only the 020 portion. The " 1 " & the "C" can be removed.

Step 4 = create new column (which would now be in H after above) called Pick Count. Data in Pick Count comes from a calculation of "Released / Conversion Factor" but only IF Pick Unit = "PAL", IF Pick Unit <> "PAL" THEN Pick Count = Concatenation of "Released and Pick Unit".

Final Order = Order#, Order Type, Isle, Slot, Released, Conversion Factor, Pick Unit, Pick Count

Not how I'd do it, but if that's the route you want to take and it gets you where you want to go ..... OK with me.
My approach would be something along the lines of this

Code:

    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    ' Rearrange Columns
    .Range("K1:K" & lr).Copy .Range("AA1")  'Order#
    .Range("L1:L" & lr).Copy .Range("AB1")  'Order Type
    .Range("N1:N" & lr).Copy .Range("AC1")  'Source Location --> Isle/Slot
    .Range("Q1:Q" & lr).Copy .Range("AE1")  'Released
    .Range("H1:H" & lr).Copy .Range("AF1")  'Conversion Factor
    .Range("O1:O" & lr).Copy .Range("AG1")  'Pick Unit
    ' delete unused columns
    .Columns("A:Z").Delete
    ' Split Source Location
    Set rng = .Range("C2:C" & lr)
    For Each cel In rng
        str = cel.Value
        cel.Value = Mid(str, 2, 2)
        cel.Offset(0, 1).Value = Mid(str, 4, Len(str) - 4)
    Next cel

I also need a function run that I can't figure out in VBA. One of the Columns is named "Slot" and it has numerical data in it. What I need is for this to work: IF value of "Slot" < 63 Then K="North" Else K="South"

If this is still required, I doubt it's still column K so you'll need to adjust. Try this.
The RC[-7] means Slot is found on same row, 7 columns to the left, adapt as necessary.

Code:

    'put in North or South 
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("K2").FormulaR1C1 = "=IF(RC[-7]<63,""North"",""South"")"
        With .Range("K2:K" & lr)
            .FillDown
            .Value = .Value
        End With

For the colorization, are you planning to accomplish this by applying conditional formatting to the sheet or VBA to set the row color ?
The VBA will use ASC() to determine the letters and the CF will use CODE().

What happened to PA

M ?

robertwp7472 · Aug 30, 2016

What happened to PAM ?

PA

M are No Color

For the colorization, are you planning to accomplish this by applying conditional formatting to the sheet or VBA to set the row color ?

Whichever is most practical; however, past experience leads me to believe that CF is more cumbersome and the VBA would be a more clean method. Am I incorrect in this thought?
--------------------------------------------------------------------------------------------------------------------------------------------------
So, please correct me if I am wrong I am trying to learn by reading your code.

Once A:Z is deleted, AA will become A and so on. That being said...
C (Source Location) is being split into C "Isle" & D "Slot" (Which code changes the column names?); this means the for the "North/South" function the K would need to be I and have a label of "Zone" and the RC[-7] would need to be RC[-5].
H is where the result of the calculation in my Step 4 would be and would have a label of "Pick Count"
--------------------------------------------------------------------------------------------
On this line of code from the rearrange columns sub

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

I am getting a compile error on the .Cells. Does there need to be a "Dim lr as Long" or something?

NoS · Aug 30, 2016

That code above is just a snippet.

With VBA there's always more than one way of doing everything.
In the attached I've use loops to get the North-South and to split for Isle-Slot.
(Loops take longer to run, but are easier to understand)

The attached doesn't include anything to color the rows.

View attachment Best Door_v2.xlsm

robertwp7472 · Aug 31, 2016

Thank you. That works great.

I am taking a shot here, let me know if this would work.

Code:

[COLOR=#008000]'This would be inserted into the pick count creation script
'result would be in G and should appear as "26CS" for example[/COLOR]

[COLOR=#0000ff]Else If[/COLOR] .Range("G" & r).Value <> "PAL" [COLOR=#0000ff]Then[/COLOR]

    [COLOR=#0000ff]Call[/COLOR] addTwoCells

[COLOR=#0000ff]-----------------------------------------------------[/COLOR]

[COLOR=#b22222][B]Private Function[/B] addTwoCells(rngA As Range, rngB As Range) As String[/COLOR]

[COLOR=#008000]' Performs concatenation of "Released" & "Pick Unit" If Value of 
' "Pick Unit" does not = PAL [/COLOR]
   
     [COLOR=#0000ff]Set[/COLOR] rngA = .Range("E" & r).Value
     [COLOR=#0000ff]Set[/COLOR] rngB = .Range("G" & r).Value    

   addTwoCells = rngA & rngB

[COLOR=#0000ff]End Function[/COLOR]

--------------------------------------------------
To answer your question about the colorization... I think I prefer the Loop option

Also, now that I see it in its nearly final state I'd like to hide Columns D, E, Fwhich would be

Code:

' hide columns D E F
Columns("D:F").EntireColumn.Hidden = True

correct? and I'd have to put its opposite into the code for the Clear Sheet function too...correct?

NoS · Aug 31, 2016

I am taking a shot here, let me know if this would work.

What happened when you tried it ?

I'd use

Code:

            .Range("H" & r).Value = .Range("E" & r) / .Range("F" & r)
        [COLOR=#ff0000]Else
            .Range("G" & r).Value = .Range("E" & r).Value & " " & .Range("G" & r).Value[/COLOR]
        End If
    Next r

Code:
Also, now that I see it in its nearly final state I'd like to hide Columns D, E, Fwhich would be

Code:

' hide columns D E F Columns("D:F").EntireColumn.Hidden = True

correct?

Columns("D:F") are entire columns, so the .entirecolumn part isn't really needed.
You ask if that's correct, and if you'd have to put its opposite into the code for the Clear Sheet function,
Did you try it ?

about the colorization... I think I prefer the Loop option

I've done it both ways and can't really say if loop or conditional formatting is easier.
This should get you started going with the loop.
There's only 3 possible first letters. Need the ascii codes to determining the letters.

Code:

' USING A LOOP TO APPLY COLORS TO ROWS
    Set rng = .Range("C3:C" & lr)
    For Each cel In rng
        If Asc(Left(cel.Value, 1)) = 65 Then  'first letter A
            If Asc(Right(cel.Value, 1)) >= 65 And Asc(Right(cel.Value, 1)) <= 75 Then 'A-K
                cel.Offset(0, -2).Resize(1, 9).Interior.Color = 16769535 'Pink
            ElseIf Asc(Right(cel.Value, 1)) >= 76 And Asc(Right(cel.Value, 1)) <= 89 Then  'L-Y
                cel.Offset(0, -2).Resize(1, 9).Interior.Color = 16772300  'Blue
            End If
        ElseIf Asc(Left(cel.Value, 1)) = 66 Then  'first letter B
            'and so on....

RE: colorization and no color for PA

M
For the data posted there are 256 PA

M, 8 AZ and one EX that will have no color.

robertwp7472 · Sep 1, 2016

I think I understand the colorizing Loop code for the most part, but I don't understand what the numbers 65, 75, 76, 89 represent and so I am not sure how to continue the code string. Are they coordinates or positioning data?
---------------------------------------------------------------------------------------------
My Bad, I did not realize that I had left AZ & EX out of the mix. AZ should be grouped with AL:AY for AL:AZ. Yes, PA

M & EX will remain no color

NoS · Sep 1, 2016

http://www.ascii-code.com/

66 = A
67 = B
etc.

NoS · Sep 1, 2016

OOps... make that 65 = A and 66 = B

robertwp7472 · Sep 2, 2016

The colorizing Loops worked great. Thank you.View attachment Best Door_v2.xlsm Here is the full code

Code:

'---------------------------------------
'| Color Legend:                                 |
'| Isle Range AA-AK Pink:   16769535     |
'| Isle Range AL-AZ Blue:   16772300     |
'| Isle Range BA-BF Green:  13434828    |
'| Isle Range BG-BT Yellow: 13434879    | 
'| Isle Range CA-CE Grey:   14540253    | 
'| Isle Range PA-PM Tan:    10741759    |
'| Isle Range EX No Color                     |
'---------------------------------------

' USING A LOOP TO APPLY COLORS TO ROWS
    Set rng = .Range("C3:C" & lr)
    For Each cel In rng
        If Asc(Left(cel.Value, 1)) = 65 Then  'first letter A
            If Asc(Right(cel.Value, 1)) >= 65 And Asc(Right(cel.Value, 1)) <= 75 Then 'A-K
                cel.Offset(0, -2).Resize(1, 9).Interior.Color = 16769535 'Pink
            ElseIf Asc(Right(cel.Value, 1)) >= 76 And Asc(Right(cel.Value, 1)) <= 90 Then  'L-Z
                cel.Offset(0, -2).Resize(1, 9).Interior.Color = 16772300  'Blue
            End If
        ElseIf Asc(Left(cel.Value, 1)) = 66 Then  'first letter B
            If Asc(Right(cel.Value, 1)) >= 65 And Asc(Right(cel.Value, 1)) <= 70 Then 'A-F
                cel.Offset(0, -2).Resize(1, 9).Interior.Color = 13434828 'Green
            ElseIf Asc(Right(cel.Value, 1)) >= 71 And Asc(Right(cel.Value, 1)) <= 84 Then  'G-T
                cel.Offset(0, -2).Resize(1, 9).Interior.Color = 13434879  'Yellow
            End If
        ElseIf Asc(Left(cel.Value, 1)) = 67 Then  'first letter c
            If Asc(Right(cel.Value, 1)) >= 65 And Asc(Right(cel.Value, 1)) <= 69 Then 'A-E
                cel.Offset(0, -2).Resize(1, 9).Interior.Color = 14540253 'Grey
            End If
        ElseIf Asc(Left(cel.Value, 1)) = 80 Then  'first letter P
            If Asc(Right(cel.Value, 1)) >= 65 And Asc(Right(cel.Value, 1)) <= 77 Then 'A-M
                cel.Offset(0, -2).Resize(1, 9).Interior.Color = 10741759 'Tan
            End If
        End If
    Next cel

I have this from the Mr. Excel board to turn on borders, but I am not sure where to insert so that it functions correctly.

Code:

With ActiveSheet.UsedRange.Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
End With

I also want to create a small jpeg image that has a color legend and insert it into the page so that it floats just below the freeze line and doesn't scroll away. I also found this code on Mr.Excel. Its description fits what I want to do but again I am unsure how and where to insert it...and I want it to use an image file named ColorLegend.jpeg

Code:

[SIZE=2][FONT=courier new]Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)     Dim MyPicture As Object     Dim MyTop As Double     Dim MyLeft As Double     Dim TopRightCell As Range     '-----------------------------------------------------------     '- top right cell     With ActiveWindow.VisibleRange[COLOR=#ff0000]         r = 1 [/COLOR]        c = .Columns.Count         Set TopRightCell = .Cells(r, c)     End With     '------------------------------------------------------------     '- position picture     Set MyPicture = ActiveSheet.Pictures(1)     MyTop = [COLOR=#ff0000]TopRightCell.Top + 5[/COLOR]     MyLeft = TopRightCell.Left - MyPicture.Width - 5     With MyPicture         .Top = MyTop         .Left = MyLeft     End With End Sub

[/FONT][/SIZE]

robertwp7472 · Sep 2, 2016

Here is that code again (not sure why it would post right before)

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Dim MyPicture As Object
    Dim MyTop As Double
    Dim MyLeft As Double
    Dim TopRightCell As Range
    '-----------------------------------------------------------
    '- top right cell
    With ActiveWindow.VisibleRange
        r = 1
        c = .Columns.Count
        Set TopRightCell = .Cells(r, c)
    End With
    '------------------------------------------------------------
    '- position picture
    Set MyPicture = ActiveSheet.Pictures(1)
    MyTop = TopRightCell.Top + 5
    MyLeft = TopRightCell.Left - MyPicture.Width - 5
    With MyPicture
        .Top = MyTop
        .Left = MyLeft
    End With
End Sub

NoS · Sep 3, 2016

For the color legend you can paste the picture on the sheet and the Clear macro won't remove it but you will need to re-position it each time.
I suspect you know exactly where you'd like it so just set the top left cell directly.

View attachment Best Door_v4.xlsm

NoS · Sep 3, 2016

.... my apologies, I didn't pick up on what you were trying to do with the color legend.

Need to disable events during the set-up of things and then the Worksheet_Selectionchange can be used exactly as per your post #16.
Hopefully this looks after that.

View attachment Best Door_v5.xlsm

robertwp7472 · Sep 3, 2016

Thank you. I had already figured out a work around . What I did was to edit the jpeg to make it longer and skinnier and then anchored it into the cells above the freeze line, but I will definitely take a look.

Now I am working on this:

Code:

[COLOR=#008000] 'Insert Blank Row when order number changes[/COLOR]
    With Range("A2", Range("A" & Rows.Count).End(xlUp))
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        .Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
        .Offset(, -1).EntireColumn.Delete
        .EntireColumn.RemoveSubtotal
        .EntireColumn.Interior.Color = 16777215[COLOR=#008000] 'Changes color to white[/COLOR]
    End With

I added this in at the end and It works great except it only seems to affect the first cell of the row being inserted. What would be great would be if it could insert a blank row with no color and then merge the cells in that row from (A:I) so that the appearance is a solid blank row with no formatting. Any thoughts?

I also seem to be having an issue with the control buttons spontaneously resizing between saves. Is there an easy way to lock them up to prevent this?

NoS · Sep 3, 2016

I've seen on other forums people having issues with controls and/or shapes resizing, believe it's a bug in Excel but would need to check with my buddy Google.

Don't know what you're trying to accomplish with what you're working on now.
Don't think you came up with that code. Care to post a link so I can see it in context.

Need Help Cleaning\Consolidate VBA and a Bug Fix + add a color to rows based on data

New member

Member

New member

Member

Member

New member

Member

New member

Member

New member

Member

New member

Member

Member

New member

Attachments

New member

Member

Member

New member

Member