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

richie247

New Member
Joined
Feb 3, 2017
Messages
14
Office Version
365, 2013
Platform
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,978
Office Version
2007
Platform
Windows
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
 

richie247

New Member
Joined
Feb 3, 2017
Messages
14
Office Version
365, 2013
Platform
Windows
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.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,978
Office Version
2007
Platform
Windows
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"?
 

richie247

New Member
Joined
Feb 3, 2017
Messages
14
Office Version
365, 2013
Platform
Windows
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?
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,978
Office Version
2007
Platform
Windows
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

xl2bb.xlam
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.
 

richie247

New Member
Joined
Feb 3, 2017
Messages
14
Office Version
365, 2013
Platform
Windows
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".
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,978
Office Version
2007
Platform
Windows
Sorry, but I don't understand the logic.
If you have the following in sheet2, then would sheet1 be all hidden shapes?

xl2bb.xlam
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.
 

richie247

New Member
Joined
Feb 3, 2017
Messages
14
Office Version
365, 2013
Platform
Windows
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,978
Office Version
2007
Platform
Windows
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
 

Forum statistics

Threads
1,078,525
Messages
5,340,978
Members
399,402
Latest member
sri0197

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top