Using VBA to select a color coded cell

karl10220

New Member
Joined
Feb 28, 2024
Messages
34
Office Version
  1. 365
Platform
  1. Windows
Hello. I have a current complex macros in which i have a horizontal data set that lists various price breaks for different quantities ordered. It then translates this into a vertical format for easier viewing and uploading into a system to manage price. This color issue is a new unique one. See that cells L3 and L4 have Yes in the Stocked column. If that's true, then cells S3 and W4 are highlighted as well. In those instances instead of showing quantities and prices for 1-44, 45-110, etc. we would only want to show quantity of 1 and the highlighted price. The rationale behind is if we are asking someone to hold inventory, they are buying in quantities that are much larger, they are getting a price break, and therefore they are able to pass that flat pricing on to us for a much lower price. So on the other lines, as we order greater or smaller quantities, the price goes up or down, but when it's stocked then if we order 1 carton or 2000 cartons of that product, the price will be the same and thus in our output file we wouldn't repeat We would take the figure from N3 or N4 and the price (highlighted) from S3 and W4, respectively.

• If it is possible to have an additional column with the In Stock Price rather than relying on colours ? Meaning is there some other feature within Excel that I could automatically call the highlighted figure to that cell, and then the macro could use If statement to if Yes is selected in stocked column, then it will omit the next rules and instead just grab that single price instead?
Otherwise,
• 1 of the Price columns (out of the 8) will have a colour and that is the one to be used to create a single line instead of the normal 8 lines ?

I will note that the current file with the data is already spitting out the color coded figure in cell AF. I just identified this was already written, so what I'd like to do is to adjust the below macro to if column L says Yes, then to only grab quantity from column N and price from AF. If it says no, then proceed as normal, because it works well. Is that possible?

1715006152734.png



VBA Code:
Sub Corrgulator_to_BPA_OP_mod()

Dim r As Long, q As Integer, lr As Long
    Dim lrData As Long, lcData As Long
    Dim NoOfQtyCols As Long
    Dim wsData As Worksheet
    Dim wsOutput As Worksheet
    Dim rngData As Range, rngOut As Range
    Dim arrData As Variant, arrOut
    Dim colQty1st As Long, colOut1st As Long

    Set wsData = ThisWorkbook.Worksheets("Corrgulator")
    Set wsOutput = ThisWorkbook.Worksheets("New BPA")
   
    With wsData
        lcData = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lrData = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngData = .Range(.Cells(1, 1), .Cells(lrData, lcData))
        arrData = rngData.Value2
        NoOfQtyCols = 8                     ' <--- No of Qty columns (each Qty has an associated Price column)
       
        ' N,P,R,T,V,X,Z,AB ---> Qty
        ' O,Q,S,U,W,Y,AA,AC ---> Price
        colQty1st = .Columns("N").Column    ' <---  Start of Qty, Price is offset 1 to the right
 
    End With
   
    With wsOutput
        lr = .Columns("E:U").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        If lr = 1 Then lr = 2
        .Range("E2:U" & lr).ClearContents
        colOut1st = .Columns("E").Column    ' <--- Starting column to be used by array
        Set rngOut = .Cells(2, colOut1st)
    End With
       
    ' Column references based on 1 being Column E - colOut1st is the offset for the starting column in the array
    Dim outSupp As Long, outItem As Long, outPrice As Long, outStore As Long, outQty As Long, outOnSite As Long
    Dim outGoods As Long, outUoM As Long
    outSupp = Columns("E").Column - colOut1st + 1
    outGoods = Columns("K").Column - colOut1st + 1
    outItem = Columns("L").Column - colOut1st + 1           ' Part Item (Part Number)
    outUoM = Columns("M").Column - colOut1st + 1
    outPrice = Columns("N").Column - colOut1st + 1
    outStore = Columns("Q").Column - colOut1st + 1          ' Ship to
    outQty = Columns("R").Column - colOut1st + 1
    outOnSite = Columns("U").Column - colOut1st + 1         ' Stocked on site? Yes/No
   
    ReDim arrOut(1 To lrData * NoOfQtyCols, 1 To outOnSite)
    lr = 0
    For r = 2 To UBound(arrData)                                            ' Loop through all items in data sheet
        For q = 1 To NoOfQtyCols                                            ' Loop through all quantities
            lr = lr + 1                                                     ' Increment row in output sheet
            arrOut(lr, outStore) = arrData(r, 3)                            ' Store    - Column C in Source
            arrOut(lr, outSupp) = arrData(r, 4)                             ' Supplier - Column D in Source
            arrOut(lr, outItem) = arrData(r, 1)                             ' Item     - Column A in Source (Part Item/Part Number)
            arrOut(lr, outOnSite) = arrData(r, 12)                          ' Stocked on Site  - Column L in Source
            arrOut(lr, outGoods) = "Goods"                                  ' Goods    - Hard Coded
            arrOut(lr, outUoM) = "Each"                                     ' Each    - Hard Coded
            
            arrOut(lr, outQty) = arrData(r, colQty1st + (q - 1) * 2)        ' Quantity
            arrOut(lr, outPrice) = arrData(r, colQty1st + 1 + (q - 1) * 2)  ' Price     - Column 1 to the right of Qty - in Source
            ' Apply Rounding
            With Application
                arrOut(lr, outPrice) = .IfError(.Round(arrOut(lr, outPrice), 3), 0)
            End With
        Next q
    Next r
   
    rngOut.Resize(lr, UBound(arrOut, 2)).Value2 = arrOut
End Sub
 
Alex, you are a genius! This worked perfectly and will yield significant process improvements! If I could hug you, I would! :biggrin:
 
Upvote 0

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Forum statistics

Threads
1,224,810
Messages
6,181,079
Members
453,021
Latest member
Justyna P

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