Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

search in range and insert match in Excel table with VBA

Status
Not open for further replies.

johnhugh

Technical User
Mar 24, 2010
702
SG
Hi,

I'm using Excel 2003 and hope someone here can help me.
With the help of other forum users I managed to get a macro which distributes values across a number of rows (code below).

In my Excel table shown below the yellow rows have been inserted with a macro.
The macro basically looks whether there is a value under SiteBalance (column P) and distributes that value across the number of rigs working for a site.
So for the example in yellow, the SiteBalance is $64,517.
The site in cell N21 is shown as 'NMM'.
The macro now looks at cell F8 and knows there are 8 rigs on that site so it's $64,517/8.
Row 13 to 20 are then inserted.
What I need help with is finding a way to insert the rig number as well in cell M13 to M20. Currently it only has the site description 'NMM' but I'm trying to get it to show all the rig numbers from the grey underlayed section on the top.

So for example if the site is NMM, the value s devided by 8 and in cells M13 to M20 the number of the rig is entered from cell G2 to T2.

With a formula I would do it like this:
=IF(COUNTIF($1:$1,M13),$E$1,IF(COUNTIF($2:$2,M13),$E$2,""))
I'm looking for a way to include this in my code however.

I'm really stuck so any help is greatly appreciated!

Code:
Sub Spread_values()
    Dim aRows, AMatchCols
    Dim LR As Long, r As Long, RwsReqd As Long
    Dim i As Long, j As Long, k As Long, x As Long, z As Long
    Dim Amt As Single
    Dim Site As String, CSS1 As String, CSS2 As String
    
    Const FR As Long = 11 '<-- First Row of actual data
    Const NumSites As Long = 4 '<--No. of possible sites
    AMatchCols = Array("J", "K", "N") '<--Cols that must match (CSS)
    
    Application.ScreenUpdating = False
    x = UBound(AMatchCols)
    aRows = Range("E1:F" & NumSites).Value
    LR = Range("P" & Rows.Count).End(xlUp).Row
    Range("E" & FR & ":P" & LR).Sort Key1:=Range("J" & FR), Order1:=xlAscending, _
        Key2:=Range("K" & FR), Order2:=xlAscending, Key3:=Range("N" & FR), _
        Order3:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
    r = LR
    Do
        If Cells(r, "P") <> 0 Then
            Site = Cells(r, AMatchCols(2)).Value
            i = 0
            Do
                i = i + 1
            Loop Until aRows(i, 1) = Site Or i = NumSites
            If aRows(i, 1) = Site Then
                RwsReqd = aRows(i, 2)
            Else
                MsgBox "Site not found in table"
                Exit Sub
            End If
            Amt = Cells(r, "P").Value / RwsReqd
            CSS1 = ""
            For j = 0 To x
                CSS1 = CSS1 & "|" & Cells(r, AMatchCols(j)).Value
            Next j
            For k = 1 To RwsReqd
'                r = r - 1
                If r >= FR - 1 Then
                    z = r
                    CSS2 = ""
                    For j = 0 To x
                        CSS2 = CSS2 & "|" & Cells(r - 1, AMatchCols(j)).Value
                    Next j
                Else
                    z = FR
                End If
                If CSS2 = CSS1 Then
                    Cells(r - 1, "Q").Value = Amt
                Else
                    With Rows(z)
                        .Insert
                        Cells(z, "E").Resize(, 11).Value = _
                            Cells(z + 1, "E").Resize(, 11).Value
                        Cells(z, "Q") = Amt
                        r = r + 1
                    End With
                End If
                r = r - 1
            Next k
        End If
        r = r - 1
    Loop While r >= FR
    Application.ScreenUpdating = True
End Sub

exceln.jpg


Excel Table
 


John,

1. your row 8 values are all #NAME! errors.

2. it is really difficult to understand what you are trying to accomplish. Please explain how this sheet works. Is there source data for this sheet?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hi Skip,

Thank you for replying.

The values in row 7 to 9 are formulae which are evaluated by our financial system at runtime of the report.
There is no other source spreadsheet.
I run this report in our finace system and based on the code in these rows it creates the report starting at row 12.
Row 1 to 4 is manual input which is required for my macro.

After the initial report is created in our finance system I run the macro to spread the values under SiteBalance.
The rows in yellow are all added by the macro.
I'm just trying to change the values in column M to be the actual rig number from G1 to R4.
So if M21 is 'NMM', search in E1:E4 for 'NMM'.
Get the number of working rigs from F1:F4 for that Site (NMM = 8). Insert the Reallocation Amount into column Q ($64,517/8 = $8,065).
Get rig number from G1 to R4 - in this example site is 'NMM' so rig numbers are '005', '011', '021', ...
Insert Rig number in cells M13 to M20.

I hope this makes more sense to you and really hope you can help me. I could also send the spreadsheet if that would help?

I just noticed in my code this line should be:
Const FR As Long = [red]13[/red] '<-- First Row of actual data is row 13
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top