Thread: Store cell values in an array and return values on specific condition

Hi All,

I need help in writing a macro which can perform following actions when cell value is YES or NO.

I have three worksheets in workbook - "Sheet1, Sheet2 and Sheet3"

- In Sheet1, I have given a condition "YES" or "NO" in cell "A1".

If cell "A1" in Sheet1 is "Yes". Perform following actions in Sheet 2 and Sheet 3:

1. From G14 to G18 and H20 to H24: Preserve/Store the existing values in an array and then set values to 0.

2. Hide Column G and H

3. Hide Rows 14 to 18 and Rows 20 to 24.

Else IF A1 in Sheet1 is "No".

1. Return values in respective cells which are stored in Array
2. Unhide Columns
2. Unhide Rows

I tried to write a VBA code for this but there were many errors. Below is the code I tried:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsEachSheet As Worksheet
    Dim MyValues()
    Dim Row As Long, i As Long
    Row = 14
    i = 1
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    For Each wsEachSheet In Sheets(Array("Sheet2", "Sheet3"))
        If UCase(Range("A1").Value) = "YES" Then
           Do While Len(Range("G" & Row, "H" & Row).Text) > 0
           ReDim Preserve MyValues(i)
           MyValues(i) = Range("G" & Row, "H" & Row).Value
           Range("G" & Row, "H" & Row).Value = 0
           Row = Row + 1
           i = i + 1
           wsEachSheet.Range("G14:G24").EntireRow.Hidden = True
           wsEachSheet.Range("G:G,H:H").EntireColumn.Hidden = True
        ElseIf UCase(Range("A1").Value) = "NO" Then
            Do While Len(Range("G" & Row, "H" & Row).Text) = 0
            Range("G" & Row, "H" & Row).Value = MyValues(i)
            Row = Row + 1
            i = i + 1
            wsEachSheet.Range("14:24").EntireRow.Hidden = False
            wsEachSheet.Range("G:G,H:H").EntireColumn.Hidden = False
        End If
    Next wsEachSheet
End Sub

hi gmalpani
"Do Whlie"

needs a "Loop" at the end
and the array wont be Preserve/Store of the next worksheet event .

you will have to store the values in another sheet for preserving

Hi,
Thanks for the response !!

Now I have tried to store values in the same worksheet but at different cell location.

Now, following actions has to be done:

IF Sheet1, Cell A1 is "YES", Then:

In Sheet 2 and Sheet 3:
- Copy Cell values (paste special values) from G14:G18 to G29:G33
- Set values of Cell G14:G18 to 0.
- Copy Cell values (paste special values) from H20:H24 to H29:H33
- Set values of Cell H20:G24 to 0.
- Hide rows from 14 to 18 and 20 to 24
- Hide Columns G:H

Else IF Sheet1, Cell A1 is "NO", Then:
In Sheet 2 and Sheet 3:
- Unhide Rows 14 to 18 and 20 to 24
- Unhide Columns G:H
- Copy Cell values (paste special values) from G29:G33 to G14:G18
- Copy Cell values (paste special values) from H29:H33 to H20:H24.


I tried to write a code for this but end up with an error. As I am a beginner in excel, I request your support to debug this code.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsEachSheet As Worksheet
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    For Each wsEachSheet In Sheets(Array("Sheet2", "Sheet3"))
        If UCase(Range("A1").Value) = "YES" Then
            wsEachSheet.Range("G14:G18").Select
            Selection.Copy
            wsEachSheet.Range("G29:G33").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            wsEachSheet.Range("G14:G18") = 0
            wsEachSheet.Range("H20:H24").Select
            Selection.Copy
            wsEachSheet.Range("H29:H33").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            wsEachSheet.Range("H20:H24") = 0
            wsEachSheet.Range("G14:G18").EntireRow.Hidden = True
            wsEachSheet.Range("H20:H24").EntireRow.Hidden = True
            wsEachSheet.Range("G:G,H:H").EntireColumn.Hidden = True
        ElseIf UCase(Range("A1").Value) = "NO" Then
            wsEachSheet.Range("G14:G18").EntireRow.Hidden = False
            wsEachSheet.Range("H20:H24").EntireRow.Hidden = False
            wsEachSheet.Range("G:G,H:H").EntireColumn.Hidden = False
            wsEachSheet.Range("G29:G33").Select
            Selection.Copy
            wsEachSheet.Range("G14:G18").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            wsEachSheet.Range("G29:G33") = 0
            wsEachSheet.Range("H29:H33").Select
            Selection.Copy
            wsEachSheet.Range("H20:H24").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            wsEachSheet.Range("H29:H33") = 0
        End If
    Next wsEachSheet
End Sub

hi gmalpani
very good effort
I dont exactly follow what goes on what sheet
this code with copy and destination

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Set ws2 = workksheets("Sheet2")
    Set ws3 = workksheets("Sheet3")
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If UCase(Range("A1").Value) = "YES" Then
        ws2.Range("G14:G18").Copy Destination:=ws3.Range("G29")
        ws2.Range("G14:G18") = 0
        ws2.Range("H20:H24").Copy Destination:=ws3.Range("H29")
        ws2.Range("H20:H24") = 0
        ws2.Range("G14:G18").EntireRow.Hidden = True
        ws2.Range("H20:H24").EntireRow.Hidden = True
        ws3.Range("G:G,H:H").EntireColumn.Hidden = True
    ElseIf UCase(Range("A1").Value) = "NO" Then
        ws2.Range("G14:G18").EntireRow.Hidden = False
        ws2.Range("H20:H24").EntireRow.Hidden = False
        ws2.Range("G:G,H:H").EntireColumn.Hidden = False
        ws2.Range("G29:G33").Copy destnation:=ws3.Range("G14")
        ws2.Range("G29:G33") = 0
        ws2.Range("H29:H33").Copy Destination:=ws3.Range("H20")
        ws2.Range("H29:H33") = 0
    End If
    Set ws2 = Nothing
    Set ws3 = Nothing
End Sub

can you explain or expand more?

Hey gmalpani
Think im getting closer

hmmm. try

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xItem
    myarray = VBA.Array("Sheet2", "Sheet3")
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If UCase(Range("A1").Value) = "YES" Then
        For Each xItem In myarray
            With Worksheets(xItem)
                .Range("G14:G18").Copy Destination:=.Range("G29")
                .Range("G14:G18") = 0
                .Range("H20:H24").Copy Destination:=.Range("H29")
                .Range("H20:H24") = 0
                .Range("G14:G18").EntireRow.Hidden = True
                .Range("H20:H24").EntireRow.Hidden = True
                .Range("G:G,H:H").EntireColumn.Hidden = True
            End With
        Next xItem
    ElseIf UCase(Range("A1").Value) = "NO" Then
        For Each xItem In myarray
            With Worksheets(xItem)
                .Range("G:G,H:H").EntireColumn.Hidden = False
                .Range("G14:G18").EntireRow.Hidden = False
                .Range("H20:H24").EntireRow.Hidden = False
                .Range("G29:G33").Copy Destination:=.Range("G14")
                .Range("G29:G33") = 0
                .Range("H29:H33").Copy Destination:=.Range("H20")
                .Range("H29:H33") = 0
            End With
        Next xItem
    End If
End Sub

we will get there

your welcome yay !