VBA to find the associated cell to another one which is in a different worksheet

Ealglez

New Member
Joined
Mar 13, 2015
Messages
28
Dear all,

I have something tricky to do in VBA and since I just started on this malarkey, I am a bit lost.

My actual macro calculates what is called "Min.DR". This is calculated based on trends in sheet "QLT_SS_Input" (steady state cases).
The min DR is then copied into the output tables. There is an output table for each of the cases analysed (called transient cases).
The tricky bit is to copy the corresponding Min DR for each transient case, as it is possible that different transient cases have THE SAME Min.DR (since the steady state case can be is the same for different transient cases).

On sheet "Cases_input" I have a table with the following headers and columns:
Transient cases - column A
Steady State Cases - Column B
SS/transient case association - Column C (I have created a list so that for each transient case the user selects the corresponding SS case for that transient case).

Lets put and example:
I have 3 transient cases: Case_T_1, Case_T_2 and Case_T_3
I have 3 steady state cases: Case_SS_1, Case_SS_2 and Case_SS_3
The association is as follows:
For Case_T_1 and Case_T_2 --> Case_SS_1
For Case_T_3 --> Case_SS_2

On sheet "QLT_SS_input" the MinDR is calculated for each SS cases (Case_SS_1, Case_SS_2 and Case_SS_3) on cells B2, D2 and F2.
The macro for this is as follows:

Code:
Sub Minimum_Drain_Rate()
'
' Minimum_Drain_Rate Macro
'
' Keyboard Shortcut: Ctrl+Shift+M
'  Insert two rows at the top
    ThisWorkbook.Sheets("QLT_SS_Input").Activate
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' For each set of time vs. QLT data (i.e for each SS case)
Dim myColumn As Long
Dim mycnounter As Long
Dim x As Long

        ThisWorkbook.Sheets("QLT_SS_Input").Activate
        myColumn = 1
        counter = 0
        x = 0
        
        Do Until (Sheets("QLT_SS_Input").Cells(4, myColumn) = "")
        Sheets("QLT_SS_Input").Activate
        Cells(1, myColumn).Select
        If Cells(4, myColumn) = "" Then
        ActiveCell = ""
        Else
            ActiveCell = "Average QLT (for the last 2 hours), m3/h="
        End If
        Cells(1, myColumn).Select
        With Selection
            .WrapText = True
        End With
        Cells(2, myColumn).Select
        If Cells(4, myColumn) = "" Then
            ActiveCell = ""
        Else
            ActiveCell = "Minimum Drain Rate (based on 110% of design rate), m3/h="
        End If
        Cells(2, myColumn).Select
        With Selection
            .WrapText = True
        End With
        Cells(3, myColumn).Select
        If Cells(4, myColumn) = "" Then
            ActiveCell = ""
        Else
            ActiveCell = "SS Case = "
        End If
        Cells(3, myColumn).Select
        With Selection
            .WrapText = True
        End With
          
        Cells(1, myColumn + 1).Select
        ActiveCell.FormulaR1C1 = _
            "=AVERAGEIF(QLT_SS_Input!C[-1], "">=""&ROUND(MAX(QLT_SS_Input!C[-1])-2, 3), QLT_SS_Input!C)"
        ActiveCell.NumberFormat = "0.00"
        
        Cells(2, myColumn + 1).Select
        ActiveCell.FormulaR1C1 = "=R[-1]C*1.1"
        ActiveCell.NumberFormat = "0.00"
                
        Cells(3, myColumn + 1).Select
        Selection.Value = Sheets("Cases_Input").Range("B4").OFFSET(1 * counter, 0)
                     
             
        ' Add formating
    
        Range("A1:B3").OFFSET(0, counter * 2).Select
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    
        x = x + 1
        myColumn = myColumn + 2
        counter = counter + 1
              

        Loop

End Sub


I also have a macro to create the output tables for each transient case on the front sheet "Calc Sheet".
On Cell B21 (merged with cell C21) there is the name of the transient case. Ex. Case_T_1
On Cell D22 there should be the calculated value of the MinDR corresponding to that transient case. Ex. For Case_T_1, the MinDR is that calculated using the SS case Case_SS_1
Note that these tables will be repeated with an offset of 6 rows (0 columns).

The tricky thing is to copy the right MinDR when the same SS case applies for different transient cases, i.e., int eh output tables the same values have to appear on cells D22 and D28 as the same SS corresponds to transient cases Case_T_1 and Case_T_2. This value will be on Sheet "QLT_SS_Input" on cell B2 as mentioned above.

I don't know how I can modified to macro above so that this works all the time.

My idea for the macro is:
a) Look at the transient case on output table (Cell B21 and offset(6,0).
b) Find this name on the cases tables (column A on Sheet "Cases_Input")
c) Look up the corresponding SS case in the same case table (column C on Sheet "Cases_Input")
d) Then look for this SS case on sheet "QLT_SS_Input" (names are in cells B3, D3, F3... on this sheet)
e) Finally in sheet "QLT_SS_Input" select the value above the corresponding SS name (minDR values are in ceels B2, D2, F2... on this sheet) and copy this values on cells D22 (offset(6,0)) the output tables...

I know this seems extremely ling and complicated, but any help - specially of this can be done in a shorter way - will be much appreciated!

Thank you very much,
E
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

Forum statistics

Threads
1,214,784
Messages
6,121,535
Members
449,037
Latest member
tmmotairi

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