Matching Quantities to Font Change by Code - excel

I previously asked a question regarding how to change font of matching items from an array on Sheet2. Now I want to go a little further and return the matching quantities to Sheet1 that matches the red fonted items. I really want to use vba to become more familiar and learn.
Here is my code below:
Dim i, j, x As Integer
Dim box1, box2, box3, box4, box5, box6, box7, box8, box9 As String
Dim c As Range 'Define two ranges so that we can loop through both sheets to check the boxes
Dim d As Range
Sheets(1).Range("B11:B30, F11:F30").Font.ColorIndex = 0 'Remove the cell styles to apply new ones
box1 = Sheets(1).Cells.Range("C2")
box2 = Sheets(1).Cells.Range("C4")
box3 = Sheets(1).Cells.Range("C6")
box4 = Sheets(1).Cells.Range("F2")
box5 = Sheets(1).Cells.Range("F4")
box6 = Sheets(1).Cells.Range("F6")
box7 = Sheets(1).Cells.Range("I2")
box8 = Sheets(1).Cells.Range("I4")
box9 = Sheets(1).Cells.Range("I6")
Qty = Sheets(1).Cells.Range("D10")
'This refers to the checkbox
For i = 1 To 10 'Loop to find the checked box in sheet2
'box 1 items and quantites
If Sheets(2).Cells(1, i) = box1 And Qty Then 'Check for checked box
For Each c In Sheets(2).Range(Sheets(2).Cells(2, i), Sheets(2).Cells(6, i))
If Sheets(2).Range(Sheets(2).Cells(2, i), Sheets(2).Cells(6, i)) = Sheets(1).Range("D11:D30").Value And Sheets(2).Range(Sheets(2).Cells(2, i), Sheets(2).Cells(6, i)) <> "" Then
x = x
Else
x = x + 1
End If
For Each d In Sheets(1).Range("B11:B30, F11:F30")
If c = d Then
Sheets(1).Cells(d.Row, d.Column).Font.ColorIndex = 3 'changes matching item to red font
End If
Next d
Next c
Please note I'm just working on returning the quantities for box 1 so far. That's why I haven't posted the full code. Please see picture for better understanding of my lists I'm pulling from:Box Lists

Related

How to get small value in specific range

I want to get 1st,2nd,3rd,...nth...small values in dates which are on column D. but there was a specific category which is shown in column E. I wrote a code to get a specific range call p. and it is working. that means when category C it selects only C values in the range. when it is equal F it gets only F values.
Now I want to get a row number of 1st small value. but category C it gives correct small value. but it becomes category F it again gave the previous results. can anyone help me with this problem.?
dim p as range, c as range, i as integer, irow as long
dim ary(1 to 5) as varient
ary(1) = "C"
ary(2) = "F"
ary(3) = "B"
ary(4) = "PC"
ary(5) = "BC"
For i = 1 To UBound(ary)
cat = ary(i)
Set p = Nothing
Set c = Nothing
For Each c In Range("E: E")
If c.Value = cat Then
If p Is Nothing Then
Set p = c.Offset()
Else
Set p = Union(p, c)
End If
End If
Next c
irow = Application.WorksheetFunction.Match(WorksheetFunction.Small(p.Offset(, -1), 1), Range("D:D"), 0)
Cells(4, 12) = Cells(irow, 5)
next i

Excel VBA Loop Rows Until Empty Cell

I have an Excel document with some plain text in a row. The cells in the range A1:A5 contain texts, then a hundred of rows down there's another few rows with text. Cells between are empty.
I've set up a Do Until loop which is supposed to copy cells with text, and then stop when an empty cell appears. My loop counts and copies 136 cells including the 5 with text.
So my question is why?
The bottom line: Hello ends up on line 136, and then there's a huge gap of empty cells until next area with text. Do the 131 white cells contain any hidden formatting causing this?
I've tried "Clear Formats" and "Clear All". I've also tried using vbNullString instead of " ".
Code snippet:
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Integer, y As Integer
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
Do Until assets.Worksheets(1).Range("A" & x) = ""
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
x = x + 1
y = y + 1
Loop
test.Worksheets(1).Range("A" & x).Value = "Hello"
End Sub
Use a For Next Statement terminating in the last used cell in column A. Only increment y if there has been a value found and transferred and let the For ... Next increment x.
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Long, y As Long
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
with assets.Worksheets(1)
for x = 1 to .cells(rows.count, 1).end(xlup).row
if cbool(len(.Range("A" & x).value2)) then
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
y = y + 1
end if
next x
test.Worksheets(1).Range("A" & y).Value = "Hello"
end with
End Sub

Find all cell containing a substring and add them

I want to add all cells that contains the word "WAGES" If a cell in column G contains the word "WAGES" the amount(column j) will be displayed. If there's 2 or more cells containing "WAGES" then their respective amounts will be added. Here's my code:
Dim i As Integer
Dim x As String, name As String
Dim a As Double, b As Double
x = "WAGES"
i = 3
Do Until Sheets("SHIPNET").Cells(i, 7) = ""
name = Sheets("SHIPNET").Cells(i, 7)
If InStr(1, name, x, 1) Then
a = Sheets("SHIPNET").Cells(i, 10).Value
i = i + 1
End If
If InStr(1, name, x, 1) Then
b = Sheets("SHIPNET").Cells(i, 10).Value
i = i + 1
End If
i = i + 1
Loop
Sheets("MACRO TEMPLATE").Cells(5, 3) = a + b
My code is only limited to 2 cell that contains "WAGES". Is there anyway to make it dynamic instead of finding 2 cells only?
In the picture's case, -28,622.20 and -50,372.64 will be added.
Why not use a SUMIF with wildcards?
One line of code to replace the whole thing.
Sheets("MACRO TEMPLATE").Cells(5, 3) = worksheetfunction.SumIf(Sheets("SHIPNET").Range("G:G"),"*WAGES*",Sheets("SHIPNET").Range("J:J"))

How to find a row in an Excel sheet using Excel Macro VBA?

My code for now is:
Set RecT = gConnect.Execute("SELECT [Volume] FROM [Output$] WHERE ((([Facilities])=""IDK"") AND (([Detail_1])=""BPL"" Or ([Detail_1])=""SI"")) ORDER BY [Detail_1];")
Worksheets("Results").Cells(52, 4).CopyFromRecordset RecT
First, with Set Rect I look for the value I want in another sheet, and then I copy it in the 4th column of the 52nd row of my sheet 'Results' ( the one in the picture). But instead of giving it the exact indexes, I want it to find that cell.
As you can see in the photo, I have to find the line where Column A = traitement, Column B = IDK and Column C = BPL.
I looked it up and found that i have to use Cells.Find , but I can't understand how to do that !
Something like this should do the trick:
Dim v As Variant
Dim i As Long
Dim compteur As Long
Dim lineFound As Boolean
'Load range contents to array
v = Range("A1:C7").Value 'Or wherever your data is
'Iterate through array until desired content found
For i = 1 To UBound(v, 1)
If v(i, 1) = "traitement" And v(i, 2) = "IDK" And v(i, 3) = "BPL" Then
compteur = i
lineFound = True
Exit For
End If
Next i
'Report
If lineFound Then
MsgBox "The thing you want is on line " & compteur
Else
MsgBox "Didn't find the thing you want."
End If

Alternating coloring groups of rows in Excel

I have an Excel Spreadsheet like this
id | data for id
| more data for id
id | data for id
id | data for id
| more data for id
| even more data for id
id | data for id
| more data for id
id | data for id
id | data for id
| more data for id
Now I want to group the data of one id by alternating the background color of the rows
var color = white
for each row
if the first cell is not empty and color is white
set color to green
if the first cell is not empty and color is green
set color to white
set background of row to color
Can anyone help me with a macro or some VBA code
Thanks
I use this formula to get the input for a conditional formatting:
=IF(B2=B1,E1,1-E1)) [content of cell E2]
Where column B contains the item that needs to be grouped and E is an auxiliary column. Every time that the upper cell (B1 on this case) is the same as the current one (B2), the upper row content from column E is returned. Otherwise, it will return 1 minus that content (that is, the outupt will be 0 or 1, depending on the value of the upper cell).
I think this does what you are looking for. Flips color when the cell in column A changes value. Runs until there is no value in column B.
Public Sub HighLightRows()
Dim i As Integer
i = 1
Dim c As Integer
c = 3 'red
Do While (Cells(i, 2) <> "")
If (Cells(i, 1) <> "") Then 'check for new ID
If c = 3 Then
c = 4 'green
Else
c = 3 'red
End If
End If
Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
i = i + 1
Loop
End Sub
Based on Jason Z's answer, which from my tests seems to be wrong (at least on Excel 2010), here's a bit of code that happens to work for me :
Public Sub HighLightRows()
Dim i As Integer
i = 2 'start at 2, cause there's nothing to compare the first row with
Dim c As Integer
c = 2 'Color 1. Check http://dmcritchie.mvps.org/excel/colors.htm for color indexes
Do While (Cells(i, 1) <> "")
If (Cells(i, 1) <> Cells(i - 1, 1)) Then 'check for different value in cell A (index=1)
If c = 2 Then
c = 34 'color 2
Else
c = 2 'color 1
End If
End If
Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
i = i + 1
Loop
End Sub
Do you have to use code?
if the table is static, then why not use the auto formatting capability?
It may also help if you "merge cells" of the same data. so maybe if you merge the cells of the "data, more data, even more data" into one cell, you can more easily deal with classic "each row is a row" case.
I'm barrowing this and tried to modify it for my use. I have order numbers in column a and some orders take multiple rows. Just want to alternate the white and gray per order number. What I have here alternates each row.
ChangeBackgroundColor()
' ChangeBackgroundColor Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
Dim a As Integer
a = 1
Dim c As Integer
c = 15 'gray
Do While (Cells(a, 2) <> "")
If (Cells(a, 1) <> "") Then 'check for new ID
If c = 15 Then
c = 2 'white
Else
c = 15 'gray
End If
End If
Rows(Trim(Str(a)) + ":" + Trim(Str(a))).Interior.ColorIndex = c
a = a + 1
Loop
End Sub
If you select the Conditional Formatting menu option under the Format menu item, you will be given a dialog that lets you construct some logic to apply to that cell.
Your logic might not be the same as your code above, it might look more like:
Cell Value is | equal to | | and | White .... Then choose the color.
You can select the add button and make the condition as large as you need.
I have reworked Bartdude's answer, for Light Grey / White based upon a configurable column, using RGB values. A boolean var is flipped when the value changes and this is used to index the colours array via the integer values of True and False. Works for me on 2010. Call the sub with the sheet number.
Public Sub HighLightRows(intSheet As Integer)
Dim intRow As Integer: intRow = 2 ' start at 2, cause there's nothing to compare the first row with
Dim intCol As Integer: intCol = 1 ' define the column with changing values
Dim Colr1 As Boolean: Colr1 = True ' Will flip True/False; adding 2 gives 1 or 2
Dim lngColors(2 + True To 2 + False) As Long ' Indexes : 1 and 2
' True = -1, array index 1. False = 0, array index 2.
lngColors(2 + False) = RGB(235, 235, 235) ' lngColors(2) = light grey
lngColors(2 + True) = RGB(255, 255, 255) ' lngColors(1) = white
Do While (Sheets(intSheet).Cells(intRow, 1) <> "")
'check for different value in intCol, flip the boolean if it's different
If (Sheets(intSheet).Cells(intRow, intCol) <> Sheets(intSheet).Cells(intRow - 1, intCol)) Then Colr1 = Not Colr1
Sheets(intSheet).Rows(intRow).Interior.Color = lngColors(2 + Colr1) ' one colour or the other
' Optional : retain borders (these no longer show through when interior colour is changed) by specifically setting them
With Sheets(intSheet).Rows(intRow).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(220, 220, 220)
End With
intRow = intRow + 1
Loop
End Sub
Optional bonus : for SQL data, colour any NULL values with the same yellow as used in SSMS
Public Sub HighLightNULLs(intSheet As Integer)
Dim intRow As Integer: intRow = 2 ' start at 2 to avoid the headings
Dim intCol As Integer
Dim lngColor As Long: lngColor = RGB(255, 255, 225) ' pale yellow
For intRow = intRow To Sheets(intSheet).UsedRange.Rows.Count
For intCol = 1 To Sheets(intSheet).UsedRange.Columns.Count
If Sheets(intSheet).Cells(intRow, intCol) = "NULL" Then Sheets(intSheet).Cells(intRow, intCol).Interior.Color = lngColor
Next intCol
Next intRow
End Sub
I use this rule in Excel to format alternating rows:
Highlight the rows you wish to apply an alternating style to.
Press "Conditional Formatting" -> New Rule
Select "Use a formula to determine which cells to format" (last entry)
Enter rule in format value: =MOD(ROW(),2)=0
Press "Format", make required formatting for alternating rows, eg. Fill -> Color.
Press OK, Press OK.
If you wish to format alternating columns instead, use =MOD(COLUMN(),2)=0
Voila!

Resources