VBA code to run over many rows and show shapes if the area is being used,

richie247

New Member
Joined
Feb 3, 2017
Messages
17
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
I have started writing a VBA code to check and see if an area is being used, (I have 52 areas) I have used a formula to see if it is true. the if it is true I get I to check another cell to see what the area is used for then change the color to the specified. the data could be a short as 10 lines on quite days and over 100 on busy days.

I think if I was to write the code it would take a long time having to change the cell references for every line.

here is a sample of the code i am using which works, i just need to try and simplify it

Sub ShowHideAreas()

If Worksheets("Sheet2").Range("G2").Value = True Then
Worksheets("Sheet1").Shapes.Range(Array("Area_A1")).Visible = msoTrue
Else
Worksheets("Sheet1").Shapes.Range(Array("Area_A1")).Visible = msoFalse
End If
If Worksheets("Sheet2").Range("G2").Value = True Then

If Worksheets("Sheet2").Range("C2") = "Yellow" Then
Worksheets("Sheet1").Shapes.Range(Array("Area_A1")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)
Else
If Worksheets("Sheet2").Range("C2") = "Blue" Then
Worksheets("Sheet1").Shapes.Range(Array("Area_A1")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(51, 102, 255)
Else
If Worksheets("Sheet2").Range("C2") = "Red" Then
Worksheets("Sheet1").Shapes.Range(Array("Area_A1")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
If Worksheets("Sheet2").Range("C2") = "Lavendar" Then
Worksheets("Sheet1").Shapes.Range(Array("Area_A1")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(204, 153, 255)

End If
End If
End If
End If
End If
End sub

the range for each area will be from G2:BM2 (all shapes area free formed and name changed to Area_xx)then down and the cell for the use of the area will be C2:C:100.

Many thanks in advance
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
The macro could be simplified to this, but I'm not sure of the relationship of row G2 to BM2 with column C2 to C100, you could explain with 3 areas what that relationship.

VBA Code:
Sub ShowHideAreas()
  Dim i As Long, sh1 As Worksheet, sh2 As Worksheet, wRGB
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
 
  For i = 1 To 52
    sh1.Shapes.Range(Array("Area_A" & i)).Visible = sh2.Cells(2, Columns("G").Column + i - 1).Value
    If sh2.Cells(2, Columns("G").Column + i - 1).Value = True Then
      Select Case sh2.Cells(i + 1, "C")
        Case "Yellow":    wRGB = RGB(255, 255, 0)
        Case "Blue":      wRGB = RGB(51, 102, 255)
        Case "Red":       wRGB = RGB(255, 0, 0)
        Case "Lavendar":  wRGB = RGB(204, 153, 255)
      End Select
      sh1.Shapes.Range(Array("Area_A" & i)).Select
      Selection.ShapeRange.Fill.ForeColor.RGB = wRGB
    End If
  Next
End Sub
 
Upvote 0
Hi Many thanks for that.

the lay out of the data sheet is attached.
1574449571765.png


each row is a booking for various people to book areas, 2:100
G to BM are the areas.
col C is the color code I will use to show different types of booking.

I need it to show all areas on different lines at the same time on the sheet 1. which I have a picture of the areas with the shape as an overlay.

again thanks for the help

hopefully this make sense.
 
Upvote 0
Unfortunately in your macro you just put an example, so I have to guess the relationships.
Better explain the relationships.
Cell C2 is for shapes "AreaA1" through "AreaA52"?
Cell C3 is for shapes "AreaB1" through "AreaB52"?
 
Upvote 0
Unfortunately in your macro you just put an example, so I have to guess the relationships.
Better explain the relationships.
Cell C2 is for shapes "AreaA1" through "AreaA52"?
Cell C3 is for shapes "AreaB1" through "AreaB52"?


all the shapes are area A1 through A52
Cell C2 is for booking 1
Cell C3 is for booking 2
Cell C100 is for booking 99
the colors are for different activities so booking 1 and booking 25 could be doing the same thing but at different times. is this possible to do with 1 set of shapes? or would I have to copy and paste the shapes and rename them AREA B1 etc?
 
Upvote 0
I'm sorry, I still don't understand what you have.
You can explain what you have and what you want to do.

If you have this in your Sheet2

Book1
ABCDEFGHIJ
1a1a2a3a4
2RedFALSETRUETRUETRUE
3BlueTRUEFALSETRUETRUE
Sheet2


What should have happened on Sheet1.
I still can't imagine what you have on Sheet1 because you haven't put an example, you could put an example based on what I put in the example on sheet2.
You also tell me the name of each shape.
 
Upvote 0
sheet 2
1574455346048.png

sheet 1
1574455482994.png


hopefully this will make sense, the areas could be any colour determined by what the value is in "C2:C100".
 
Upvote 0
Sorry, but I don't understand the logic.
If you have the following in sheet2, then would sheet1 be all hidden shapes?

Book1
ABCDEFGHIJ
1TIMEWHOWHATWHEREa1a2a3a4
27JOHRedTRUETRUETRUETRUE
3730PAULBlueFALSEFALSEFALSEFALSE
Sheet2


Or do you have 8 shapes 4 are for John and 4 are for Paul? What is the name of the shape of John and what is the name of the shape of Paul?
That's why I asked for the names of the shapes.
 
Upvote 0
on sheet one I have 53 shapes which are all hidden. named Area_A1, Area_A2 through to Area_A53. they each correspond to a location on sheet 1.

in "G2" i us the following formula "=ISNUMBER(SEARCH(G$1,$D$2))" this is so I can add the areas that each person wants to use in "D".

so from what you have
all the shapes would be red

if you had row 2 a1, a2, a3 true and a4 false
and row 3 a1, a2, a3 false and a4 true

the output would be 3 red areas and 1 blue area.

1574458472727.png
 
Upvote 0
Try this please:

VBA Code:
Sub ShowHideAreas()
  Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long
  Dim wRGB As Variant, shp As Object
  '
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  '
  sh1.Select
  For Each shp In sh1.Shapes
    If LCase(Left(shp.Name, 6)) = LCase("Area_A") Then
      shp.Visible = False
    End If
  Next
  '
  For i = 2 To sh2.Range("C" & Rows.Count).End(xlUp).Row
    For j = 1 To 52
      If sh2.Cells(i, Columns("G").Column + j - 1).Value = True Then
        sh1.Shapes.Range(Array("Area_A" & j)).Visible = True
        Select Case sh2.Range("C" & i)
          Case "Yellow":    wRGB = RGB(255, 255, 0)
          Case "Blue":      wRGB = RGB(51, 102, 255)
          Case "Red":       wRGB = RGB(255, 0, 0)
          Case "Lavendar":  wRGB = RGB(204, 153, 255)
        End Select
        sh1.Shapes.Range(Array("Area_A" & j)).Select
        Selection.ShapeRange.Fill.ForeColor.RGB = wRGB
      End If
    Next
  Next
  MsgBox "Done"
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,239
Members
448,555
Latest member
RobertJones1986

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