vba borders and conditional formatting

[mkuznetsov1]

Hello,

I have several questions, this code was from a mix of vba forums, google, and me playing with it. It all runs but at the end it does not do what I want. I start with a workbook from the previous day and have a button that I paste this code into. It takes all the info from the last day and pastes it over to a new workbook sheet. The columns I am modifying are in A and L...as they days go by there may be additional information added onto it from other people. Just a note, column L may have my notes but may sometimes be blank if I dont need to add notes. Here are my goals.

-Put a border around each cell in the range A4 thru L (last row with content)
-Fill the range B:K in green if the cell in column C contains "wal" AND the cell next to it in D contains "ENG"
-Fill the range B:K in red if the row meets this criteria, cell in column D contains "ENG" and, cell in I is = or > 5, and cell in L DOES NOT contain "ofa" or "woi"

I think my issue is something about referencing another workbook but I cannot figure out why. I got the cell to fill green but only the cell and not a range.

Here is all my code for reference.


Private Sub CommandButton1_Click()
Dim newWorkBookFile As String
Dim newWB As Workbook
Dim newWBSheet As Worksheet
Dim oldWBSheet As Worksheet
Dim oldWBDataStartingRow As Long
Dim newWBDataRow As Long
Dim oldWBCurrentRow As Long
Dim newWBFoundMatchingDescRow As Long
Dim oldWBLastRow As Long
Dim oldWBCurrentDesc As String
Dim newWBCurrentDesc As String
newWorkBookFile = "REMOVED FOR SECURITY​"
Set oldWBSheet = ThisWorkbook.ActiveSheet
Set newWB = Workbooks.Open(newWorkBookFile)
'SHEET WAS SHEET 1
Set newWBSheet = newWB.Sheets("NoPart_CO_Check")
'STARTING ROW WAS 2
oldWBDataStartingRow = 4
' find the last row with data in the old workbook in column A
oldWBLastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row
' loop through the rows in the current worksheet (old workbook)
' use the description column information
' and compare it to the description column in the new workbook
' if it is found then copy the data in cols C - F
' to the new workbook row
For oldWBCurrentRow = oldWBDataStartingRow To oldWBLastRow
' the description to compare is found in column "F"
oldWBCurrentDesc = oldWBSheet.Cells(oldWBCurrentRow, 6)
newWBCurrentDesc = " " ' set this to 1 space so the Do loop starts
'ROW WAS 2
newWBDataRow = 4 ' what row to start searching in the new workbook
' now loop through the new wookbook to see if this description is found
' stop when there is nothing contained in the description cell
'DATA ROW WAS 2
Do While Len(newWBCurrentDesc) > 0
newWBCurrentDesc = newWBSheet.Cells(newWBDataRow, 6)
If oldWBCurrentDesc = newWBCurrentDesc Then
' found the description, now copy the information over to the new workbook
newWBSheet.Cells(newWBDataRow, 1).Value = oldWBSheet.Cells(oldWBCurrentRow, 1).Value
newWBSheet.Cells(newWBDataRow, 2).Value = oldWBSheet.Cells(oldWBCurrentRow, 2).Value
newWBSheet.Cells(newWBDataRow, 3).Value = oldWBSheet.Cells(oldWBCurrentRow, 3).Value
newWBSheet.Cells(newWBDataRow, 5).Value = oldWBSheet.Cells(oldWBCurrentRow, 5).Value
newWBSheet.Cells(newWBDataRow, 6).Value = oldWBSheet.Cells(oldWBCurrentRow, 6).Value
newWBSheet.Cells(newWBDataRow, 10).Value = oldWBSheet.Cells(oldWBCurrentRow, 10).Value
newWBSheet.Cells(newWBDataRow, 11).Value = oldWBSheet.Cells(oldWBCurrentRow, 11).Value
newWBSheet.Cells(newWBDataRow, 12).Value = oldWBSheet.Cells(oldWBCurrentRow, 12).Value
If newWBSheet.Cells(newWBDataRow, 6).Interior.Color = RGB(192, 192, 192) Then
'If Cell.Interior.Color = Excel.XlRgbColor.rgbYellow Then
newWBSheet.Cells(newWBDataRow, 12).Clear
End If
If newWBSheet.Cells(newWBDataRow, 6).Interior.Color = RGB(192, 192, 192) Then
'If Cell.Interior.Color = Excel.XlRgbColor.rgbYellow Then
newWBSheet.Cells(newWBDataRow, 1).Clear
End If
' mark the row in the new wookbook as updated so you know which rows to manually check
newWBSheet.Cells(newWBDataRow, 13).Value = "Updated"
Exit Do ' once a match is found there is no need to keep looking in the new workbook
End If
newWBDataRow = newWBDataRow + 1
Loop
'AUTO FIT COLUMN SIZES
Next oldWBCurrentRow
newWB.Sheets("NoPart_CO_Check").Columns("A:L").EntireColumn.AutoFit
'MAKE ALL ROWS SAME HEIGHT
newWB.Sheets("NoPart_CO_Check").Rows("1:1000").RowHeight = 15
'ALIGN NOTES COLUMN LEFT
With Selection
newWB.Sheets("NoPart_CO_Check").Columns("L").HorizontalAlignment = xlLeft
End With
'BORDER DOES NOT WORK HERE
Dim LastRow As Long, LastCol As Long
newWB.Sheets("NoPart_CO_Check").Cells.Borders.LineStyle = xlNone
LastRow = newWB.Sheets("NoPart_CO_Check").Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
LastCol = newWB.Sheets("NoPart_CO_Check").Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
With Range("A3", Cells(LastRow, LastCol))
.BorderAround xlDouble
newWB.Sheets("NoPart_CO_Check").Rows.Borders(xlInsideHorizontal).LineStyle = xlThin
newWB.Sheets("NoPart_CO_Check").Rows.Borders(xlInsideVertical).LineStyle = xlThin
End With
'CONDITIONAL FORMATTING DOES NOT WORK HERE
Dim TargetRange As Range
Dim Cell As Range
' Set the target range where you want to apply the formatting
Set TargetRange = newWB.Sheets("NoPart_CO_Check").Range("B4:l4") ' Change this to your desired range
' Loop through each cell in the target range
For Each Cell In TargetRange
' Check if the cell in column C contains "WAL" and the cell in the next column contains "ENG"
If Cell.Offset(0, 1).Value = "WAL" And Cell.Value = "ENG" Then
' Apply the green fill color to the entire range from B to L
TargetRange.Interior.Color = RGB(0, 255, 0) ' RGB color for green
'Exit For ' Exit the loop after the first match if you only want to highlight one occurrence
End If
Next Cell

'WORKING NOTES (DISREGARD)
' Dim lRow As Long
'Dim lCol As Long
'Find the last non-blank cell in column A(1)
' lRow = Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
' lCol = Cells(1, Columns.Count).End(xlToLeft).Column
'MsgBox "Last Row: " & lRow & vbNewLine & _
' "Last Column: " & lCol
' show the new workbook so it can be manually checked
newWB.Activate
End Sub

[Aussiebear]

Please use code tags to wrap your supplied code to the forum. See the first Line in my signature for a hint.

[jdelano]

Perhaps this will help a little


Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = Sheet1.Range("A12:L12")
' set a border on a range
rng.Borders.Color = vbBlue
rng.Borders.LineStyle = xlContinuous
rng.Borders.Weight = xlThin
' set the internal color of a range
If Sheet1.Range("C2").Value = "wal" And Sheet1.Range("D2").Value = "ENG" Then
Set rng = Sheet1.Range("E2:I2")
If Sheet1.Range("D2").Value = "ENG" And Int(Sheet1.Range("C3").Value) >= 5 _
And ((InStr(Sheet1.Range("D3").Value, "ofa") = 0 And InStr(Sheet1.Range("D3").Value, "woi") = 0)) Then
rng.Interior.Color = vbRed
Else
rng.Interior.Color = vbGreen
End If
End If
End Sub

Each screenshot shows the sheet after clicking the button

[mkuznetsov1]

Hey Jdelano,

I may be wrong but I believe you did the first part of this code on a previous thread, if so thank you...much quicker now.

Regarding the formatting fixes...that code would apply solely to the ranges in the code correct? not through the entire sheet?

[jdelano]

Correct, only the range is formatted.