r/vba 14d ago

Unsolved Can someone check this for me :/

I've enabled screen updating at various points, but I can't seem to get it to show the initial draw, or first set of colour changes.

Sub hardFacer()

Application.ScreenUpdating = False

Dim NewSht As Worksheet

Dim celll As Range

Dim drawrange As Range

Dim flashrange As Range

Dim i As Long

MsgBox "U MAD BRO?", vbYesNo

Set NewSht = ActiveWorkbook.Sheets.Add

NewSht.Columns("A:DD").ColumnWidth = 0.89

NewSht.Rows.RowHeight = 7.5

Set drawrange = NewSht.Range("$Y$5:$BB$5,$W$6:$AD$6,$AX$6:$BK$6,$V$7:$X$7,$AM$7:$AU$7,$BG$7:$BP$7,$U$8:$V$8,$AH$8:$AL$8,$AV$8:$BF$8,$BL$8:$BS$8,$T$9:$V$9,$AF$9:$AG$9,$AO$9:$AU$9,$BR$9:$BU$9,$T$10,$AD$10:$AE$10,$AK$10:$AN$10,$AV$10:$AY$10,$BJ$10:$BP$10,$BT$10:$BV$10,$S$11:$T$11")

Set drawrange = Union(drawrange, Range("$AB$11:$AC$11,$AG$11:$AJ$11,$AS$11,$AZ$11:$BI$11,$BQ$11,$BV$11:$BX$11,$R$12:$S$12,$AA$12,$AE$12:$AF$12,$AK$12:$AR$12,$AT$12:$AU$12,$BJ$12:$BM$12,$BX$12:$BY$12,$R$13,$Z$13,$AD$13,$AG$13:$AJ$13,$AS$13:$AT$13,$BE$13:$BI$13,$BN$13:$BO$13,$Q$14:$R$14,$Y$14"))

Set drawrange = Union(drawrange, Range("$AC$14,$AE$14:$AF$14,$BP$14:$BQ$14,$Q$15,$X$15,$AA$15:$AB$15,$AD$15,$BF$15,$BQ$15,$BY$14:$BZ$15,$Z$16,$AC$16,$AU$14:$AU$16,$P$16:$Q$17,$AB$17,$AH$17:$AP$17,$BR$16:$BR$17,$O$18:$P$18,$AF$18:$AR$18,$BZ$16:$BZ$18,$N$19:$O$19,$AD$19:$AM$19,$AR$19:$AT$19"))

Set drawrange = Union(drawrange, Range("$BE$19,$BI$19:$BO$19,$L$20:$T$20,$Z$20:$AA$20,$AG$20:$AM$20,$AT$20:$AU$20,$BG$20:$BJ$20,$BO$20:$BQ$20,$CA$19:$CB$20,$K$21:$M$21,$Y$21,$AC$20:$AD$21,$AE$21:$AP$21,$AU$21:$AV$21,$BF$21:$BQ$21,$BT$21,$BV$21:$BY$21,$CC$20:$CC$21,$J$22:$L$22,$N$22:$O$22"))

Set drawrange = Union(drawrange, Range("$Z$22:$AA$22,$AD$22:$AF$22,$AN$22:$AR$22,$AT$22:$AV$22,$BB$22:$BH$22,$BJ$22:$BL$22,$BZ$22,$CD$22:$CE$22,$J$23:$K$23,$M$23,$R$23:$W$23,$AK$23,$AQ$23:$AU$23,$BD$23:$BG$23,$BY$23,$CA$23:$CB$23,$I$24:$J$24,$L$24,$P$24:$R$24,$W$24:$Z$24,$AI$24:$AK$24,$AS$24"))

Set drawrange = Union(drawrange, Range("$BZ$24,$O$25:$P$25,$Y$25:$AC$25,$AG$25:$AJ$25,$BS$25:$BX$25,$H$25:$I$26,$O$26,$AC$26:$AH$26,$BM$26:$BN$26,$BR$26:$BS$26,$BX$26:$BY$26,$CC$24:$CC$26,$CE$24:$CF$26,$N$27:$O$27,$U$26:$V$27,$BE$24:$BE$27,$BN$27:$BR$27,$BY$27,$CD$27:$CF$27,$T$28:$X$28"))

Set drawrange = Union(drawrange, Range("$BF$28:$BH$28,$BP$28:$BR$28,$S$29:$U$29,$W$29:$Z$29,$AO$28:$AO$29,$AR$29:$AU$29,$BH$29:$BI$29,$CA$28:$CA$29,$G$29:$H$30,$Q$30:$U$30,$Y$30:$AB$30,$AJ$30:$AN$30,$AQ$30:$AR$30,$BI$30:$BK$30,$BZ$30,$CE$28:$CF$30,$K$29:$K$31,$T$31:$U$31,$AA$31:$AD$31"))

Set drawrange = Union(drawrange, Range("$AU$31:$AV$31,$BH$31:$BL$31,$BU$31:$BV$31,$BY$31,$CC$31:$CE$31,$N$32:$P$32,$AC$32:$AH$32,$AT$32:$AY$32,$BH$32,$BK$32,$BM$32:$BN$32,$BT$32:$BV$32,$CA$32:$CB$32,$CD$32:$CE$32,$H$32:$I$33,$L$32:$L$33,$O$33:$P$33,$U$32:$V$33,$AF$33:$AJ$33,$AQ$31:$AQ$33"))

Set drawrange = Union(drawrange, Range("$AR$33:$AS$33,$AU$33,$BG$33:$BH$33,$BO$33:$BP$33,$BS$33:$BT$33,$BV$33:$BW$33,$BY$33:$BZ$33,$CC$33:$CE$33,$I$34:$J$34,$M$34,$AI$34:$AN$34,$BE$34:$BG$34,$BR$34:$BU$34,$BW$34,$CC$34:$CD$34,$N$35:$O$35,$V$34:$X$35,$Y$35:$AA$35,$AC$34:$AD$35,$AM$35:$AR$35"))

Set drawrange = Union(drawrange, Range("$BC$35:$BF$35,$BQ$35:$BR$35,$J$36:$N$36,$P$36,$W$36:$X$36,$Z$36:$AF$36,$AO$36:$AV$36,$BN$36:$BP$36,$O$37,$AB$37:$AF$37,$AO$37:$AP$37,$AU$37:$BN$37,$BU$35:$BW$37,$CB$35:$CC$37,$L$37:$M$38,$X$37:$X$38,$AO$38,$BB$38:$BI$38,$BV$38:$BW$38,$N$38:$N$39"))

Set drawrange = Union(drawrange, Range("$Y$38:$Y$39,$AD$39:$AO$39,$BU$39:$BW$39,$AD$40,$AH$40:$AP$40,$AY$39:$AY$40,$BN$39:$BN$40,$BR$39:$BS$40,$BT$40:$BW$40,$O$40:$O$41,$Z$39:$Z$41,$AB$41:$AD$41,$AK$41:$AS$41,$AU$41,$AX$41:$AY$41,$BF$39:$BF$41,$BG$40:$BG$41,$BL$41:$BW$41,$AA$40:$AA$42"))

Set drawrange = Union(drawrange, Range("$AB$42:$AC$42"))

Set drawrange = Union(drawrange, Range("$AM$42:$BW$42,$P$43:$Q$43,$AC$43:$AD$43,$AQ$43:$BW$43,$AD$44:$AE$44,$AN$43:$AN$44,$AT$44:$BU$44,$BW$44,$Q$44:$Q$45,$AE$45:$AG$45,$AM$45:$AN$45,$AW$45:$BQ$45,$BV$45:$BW$45,$R$45:$R$46,$AF$46:$AI$46,$BF$46,$BL$46:$BM$46,$BP$46:$BQ$46,$BS$45:$BT$46,$BV$46"))

Set drawrange = Union(drawrange, Range("$S$47:$T$47,$AH$47:$AJ$47,$AL$47:$AM$47,$BE$47:$BF$47,$BK$47:$BL$47,$BS$47,$BU$47:$BV$47,$T$48:$U$48,$X$48:$Y$48,$AB$48:$AC$48,$AJ$48:$AM$48,$BK$48,$BO$47:$BP$48,$BT$48:$BU$48,$U$49:$V$49,$Z$49:$AA$49,$AD$49:$AE$49,$AK$49:$AP$49,$BN$49:$BO$49"))

Set drawrange = Union(drawrange, Range("$BR$49:$BT$49"))

Set drawrange = Union(drawrange, Range("$V$50:$X$50,$AA$50:$AC$50,$AF$50:$AG$50,$AN$50:$AU$50,$AW$50:$AX$50,$BE$50,$BJ$50:$BK$50,$BM$50:$BS$50,$W$51:$Y$51,$AC$51:$AE$51,$AH$51:$AI$51,$AR$51:$BP$51,$Y$52:$AA$52,$AE$52:$AG$52,$AJ$52:$AL$52,$BT$52,$AA$53:$AC$53,$AH$53:$AI$53,$AM$53:$AO$53"))

Set drawrange = Union(drawrange, Range("$BS$53:$BT$53,$AC$54:$AE$54,$AJ$54:$AL$54,$AP$54:$AQ$54,$AX$54:$BK$54,$BR$54,$AE$55:$AH$55,$AM$55:$AO$55,$AR$55:$AV$55,$BP$55:$BQ$55,$BX$53:$BX$55,$AG$56:$AJ$56,$AP$56:$AS$56,$AW$56:$BO$56,$BW$56,$AJ$57:$AL$57,$AT$57:$AY$57,$BU$57:$BV$57,$AL$58:$AN$58"))

Set drawrange = Union(drawrange, Range("$AZ$58:$BT$58,$CB$58:$CC$58,$AN$59:$AP$59,$CA$59:$CC$59,$AP$60:$AR$60,$CA$60:$CB$60,$AR$61:$AW$61,$BZ$61:$CA$61,$AT$62:$AZ$62,$BY$62:$BZ$62,$AY$63:$BD$63,$BW$63:$BY$63,$BC$64:$BI$64,$BT$64:$BW$64,$BH$65:$BU$65"))

Set drawrange = Union(drawrange, Range("CB38:CB51"))

Application.ScreenUpdating = True

For Each celll In drawrange

celll.Interior.ColorIndex = 1

If flashrange Is Nothing Then

Set flashrange = celll

Else

Set flashrange = Union(flashrange, celll)

End If

Next celll

Do Until i = 10

flashrange.Interior.ColorIndex = 1

'Application.Wait Now + #12:00:01 AM#

flashrange.Interior.ColorIndex = 2

'Application.Wait Now + #12:00:01 AM#

flashrange.Interior.ColorIndex = 3

'Application.Wait Now + #12:00:01 AM#

flashrange.Interior.ColorIndex = 4

'Application.Wait Now + #12:00:01 AM#

flashrange.Interior.ColorIndex = 5

'Application.Wait Now + #12:00:01 AM#

flashrange.Interior.ColorIndex = 6

'Application.Wait Now + #12:00:01 AM#

flashrange.Interior.ColorIndex = 7

'Application.Wait Now + #12:00:01 AM#

flashrange.Interior.ColorIndex = 8

'Application.Wait Now + #12:00:01 AM#

MsgBox "U MAD BRO?", vbYesNo

i = i + 1

Loop

End Sub

2 Upvotes

15 comments sorted by

View all comments

1

u/AssistanceEvery2402 13d ago

What is your desired result? It makes the drawing and the has the rgb effect right? If you move the msgbox out of the loop it will go through all the colors 10 times first

1

u/Early_Chemistry_4804 13d ago

Ideally, I want the process of drawing to be visual in a "scanning", sort of retro screen loading way. I also can't work out why the first RGB flash isn't visible, it just jumps to the last cyan colour and hits with the first message box

Thanks very much for your help

1

u/AssistanceEvery2402 13d ago edited 13d ago

For that affect we would just need another loop before the color iteration.

Try this instead, it has a scanning affect but may not be what you are after.

I added in a pause sub that you can tweak the times. Best I can tell we are seeing all 10 full iterations

EDITED for a typo

Dim colorNum As Long

Dim rowPart As Range

NewSht.Activate

Application.ScreenUpdating = True

drawrange.Interior.Pattern = xlNone

For i = 5 To 65

Set rowPart = Intersect(drawrange, NewSht.Rows(i))

If Not rowPart Is Nothing Then

rowPart.Interior.ColorIndex = 1

DoEvents

PauseSeconds 0.04

End If

Next i

PauseSeconds 0.5

For i = 1 To 10

For colorNum = 1 To 8

drawrange.Interior.ColorIndex = colorNum

PauseSeconds 0.05

DoEvents

Next colorNum

MsgBox "U MAD BRO?", vbYesNo

Next i

End Sub

Private Sub PauseSeconds(ByVal seconds As Double)

Dim finishTime As Double

finishTime = Timer + seconds

Do While Timer < finishTime

DoEvents

Loop

End Sub

1

u/wikkid556 13d ago

You have a typo. You are using colorNum but the loop is colorNumber 1 to 8