Format one half of spreadsheet red, and fill down until last row

Question

I've got a macro which successfully takes a table with 44 columns and reduces it down to to 12. It splits the top section (where our supplier has sent no stock and the cell in the total column would show a 0) and sticks it at the top of the worksheet, and it inserts checkboxes (to an extent).

I tried really hard to make a markdown table but it wouldn't display properly. Below is (top) how the data currently looks and (bottom) the desired result! :-)

What I'm ideally wanting to do is make it so that the top section is formatted red (where we've not got any stock sent) and the checkboxes are filled down until the final row. I can't work out how to do this. I'd also like to sort the section NOT in red by column 'A' (code).

Any help most welcome!

Thanks

Sub separate()
    Columns("A:N").Select
    Range("N1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("A:J").Select
    Range("J1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("D5").Select
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "CHK"
    Columns("F:F").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("G:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Range("F5").Select
    Columns("C:C").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "VAT"
    Range("J6").Select
Dim wb As Workbook, ws As Worksheet, myrange As Range
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
Set range_i = Nothing
counter = 0
Tre = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For Tr = 2 To Tre
If ws.Cells(Tr, 13) = 0 Then
    If Not myrange Is Nothing Then
        Set myrange = Union(myrange, Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13)))
    Else
        Set myrange = Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13))
    End If
    counter = counter + 1
End If

If Not range_i Is Nothing Then
    If ws.Cells(Tr, 13) > 0 Then
        Set range_i = Union(range_i, Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13)))
    End If
Else
    If ws.Cells(Tr, 13) > 0 Then
        Set range_i = Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13))
    End If
End If
Next Tr
Sheets.Add.Name = "summary"
Set Tws = wb.Sheets("summary")
myrange.Copy
Tws.Range("A1").PasteSpecial
range_i.Copy
Tws.Range(Cells(1 + counter, 1), Cells(1 + counter, 13)).PasteSpecial
    Sheets("Sheet1").Range("A1:M1").Copy
    Sheets("summary").Select
    Range("A1").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets(Array("Sheet1")).Delete
Application.DisplayAlerts = True
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "o"
    Columns("D:D").Select
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D268")
    Range("D2:D268").Select
    Range("E6").Select
End Sub

will it? That's great but it's within a macro so wasn't sure how to apply it? — daneee, Jun 02 '21 at 11:32
[This Question covers adding checkboxes via VBA](https://stackoverflow.com/questions/16992195/insert-check-box-to-a-particular-cell-through-vba-macro) — Samuel Everson, Jun 02 '21 at 11:46

score 0 · Answer 1 · answered Jun 02 '21 at 11:26

First off, you may benefit from reading How to avoid using Select in Excel VBA which can help improve the overall function and performance of your code, not to mention it will likely help simplify it greatly.

There are a few ways you could acheive your goal.

The first that came to mind for me was to loop through a set range (perhaps you can set this based on something in your current code) and if the column G value is 0 set the row text colour to red.

For example;

Sub redtext()
    Dim TargetRow As Long
    
    For TargetRow = 1 To 10
        If Cells(TargetRow, "G").Value = "0" Then
            Range("A" & TargetRow & ":J" & TargetRow).Font.Color = vbRed
        End If
    Next TargetRow
End Sub

Note: The above is a simple example that loops through rows 1 to 10. You should make explicit reference to your objects (like reference the worksheet/workbook as without this objects like Cells() have an implicit reference to the ActiveSheet.

That is fantastic in terms of setting the cells red based on a value, thank you - I just need to work out how to use "Tre" to fill in the checkboxes but "D" + Tre didn't do it, just got a type mismatch error. Thank you — daneee, Jun 02 '21 at 11:37
@daneee I must have read over the checkbox part sorry, I'll take a further look. — Samuel Everson, Jun 02 '21 at 11:39

Kin Siang · Answer 2 · 2021-06-02T13:45:08.810

0

Let me explain on how to set up a conditional formatting on your excel, you can dump the super long VBA code which there is a in-built function in excel to solve your problem, the highlight text is dynamic one:

Select all the data where you want to highlight (Red circle on image below), then Select Conditional Formatting > new rule
On the interface, choose Use a formula to determine which cell to format, click the qty range and enter the formula =0 and remove the $ and choose the format for red font then press ok

3)You may go to Conditional Formatting > Manage rule to adjust the range or the formula or the format in anytime.

https://drive.google.com/file/d/1dWb9GV3LJqZfP408cj3jvqUKTmKMFJbG/view?usp=sharing

edited Jun 02 '21 at 13:45

answered Jun 02 '21 at 11:47

Kin Siang

2,644
2
4
8

Thanks, I'll try to "record" that as a macro and see if it is reproduceable. Cheers! – daneee Jun 02 '21 at 11:48
Yes, please try, it is far more better than use VBA in your case – Kin Siang Jun 02 '21 at 11:49
hmm, can't make it work - sorry! But this works fine Dim TargetRow As Long For TargetRow = 1 To 10 If Cells(TargetRow, "G").Value = "0" Then Range("A" & TargetRow & ":J" & TargetRow).Font.Color = vbRed End If Next TargetRow – daneee Jun 02 '21 at 13:34
Let me try upload a clip if possible lol. – Kin Siang Jun 02 '21 at 13:37
ok, you can check on link to a short video recorded by me, hope you know how to use it lol – Kin Siang Jun 02 '21 at 13:45

Format one half of spreadsheet red, and fill down until last row

2 Answers2

Linked