Problem facing to running the macro

[PRADEEPB270]

Hi Hans,

How are you?
Please refer my attach file.In this file,go to all sheets except first one.When I am running the macro,it is running well but not to pick the figure of "Point-36D".Can you examine the codes where the problems exist?
For an example,run the macro 'Cost audit proformas value' and look the sheet CNDKDRKCC-D and cell no.E69.The value should come as appear in cell no.I69.

Please have a look and refine my coding errors.

[HansV]

The VBA project is password-protected, so I can't view the macros.

[PRADEEPB270]

Sorry .Please refer new attachment.

[HansV]

Thanks, I'll take a look at it.

[HansV]

The code stops at row 64 of the CNDKDRKCC-D sheet since H64 is empty. To loop to the end of the data:

Code: Select all

Sub CostauditproformasValues()
    Const strWorking = "Working for Proforma"
    Const lngPointCol = 8 ' H
    Const lngDestCol1 = 6 ' F
    Const lngDestCol2 = 5 ' E
    Const lngModelCol = 2 ' B
    Dim wshOther As Worksheet
    Dim wshWorking As Worksheet
    Dim strPoint As String
    Dim lngDestCol As Long
    Dim lngPointRow As Long
    Dim lngLastPointRow As Long
    Dim lngDataRow As Long
    Dim lngDataCol As Long
    Dim rngFound As Range
    Application.ScreenUpdating = False
    Set wshWorking = Worksheets(strWorking)
    For Each wshOther In Worksheets
        If wshOther.Name <> strWorking Then
            lngPointRow = wshOther.Cells(1, lngPointCol).End(xlDown).Row
            strPoint = wshOther.Cells(lngPointRow, lngPointCol).Value
            Do While strPoint <> ""
                Set rngFound = wshWorking.Cells.Find(What:=strPoint, LookAt:=xlWhole)
                If Not rngFound Is Nothing Then
                    lngDataRow = rngFound.Row
                    lngDataCol = rngFound.Column
                    Set rngFound = wshWorking.Range(wshWorking.Cells(lngDataRow, lngModelCol), _
                        wshWorking.Cells(wshWorking.Rows.Count, lngModelCol)) _
                        .Find(What:=wshOther.Name, LookAt:=xlWhole)
                    If Not rngFound Is Nothing Then
                        lngDataRow = rngFound.Row
                        wshOther.Cells(lngPointRow, lngDestCol1).Value = _
                            wshWorking.Cells(lngDataRow, lngDataCol).Value
                    Else
                        ' Optional
                        wshOther.Cells(lngPointRow, lngDestCol1).ClearContents
                    End If
                Else
                    ' Optional
                    wshOther.Cells(lngPointRow, lngDestCol1).ClearContents
                End If
                lngPointRow = lngPointRow + 1
                strPoint = wshOther.Cells(lngPointRow, lngPointCol).Value
            Loop
            lngLastPointRow = wshOther.Cells(wshOther.Rows.Count, lngPointCol).End(xlUp).Row
            For lngPointRow = wshOther.Cells(lngPointRow, lngPointCol).End(xlDown).Row To lngLastPointRow
                strPoint = wshOther.Cells(lngPointRow, lngPointCol).Value
                If strPoint <> "" Then
                    Set rngFound = wshWorking.Cells.Find(What:=strPoint, LookAt:=xlWhole)
                    If Not rngFound Is Nothing Then
                        lngDataRow = rngFound.Row
                        lngDataCol = rngFound.Column
                        Set rngFound = wshWorking.Range(wshWorking.Cells(lngDataRow, lngModelCol), _
                            wshWorking.Cells(wshWorking.Rows.Count, lngModelCol)) _
                            .Find(What:=wshOther.Name, LookAt:=xlWhole)
                        If Not rngFound Is Nothing Then
                            lngDataRow = rngFound.Row
                            wshOther.Cells(lngPointRow, lngDestCol2).Value = _
                                wshWorking.Cells(lngDataRow, lngDataCol).Value
                        Else
                            ' Optional - clear cell if point-value not found
                            ' Remove next line if you don't want that
                            wshOther.Cells(lngPointRow, lngDestCol2).ClearContents
                        End If
                    Else
                        ' Optional - clear cell if point-value not found
                        ' Remove next line if you don't want that
                        wshOther.Cells(lngPointRow, lngDestCol2).ClearContents
                    End If
                End If
            Next lngPointRow
        End If
    Next wshOther
    Application.ScreenUpdating = True
End Sub

[PRADEEPB270]

I am very grateful to you Hans for the nice help in my sticking.Now,the codes are working fine.
Thanks for the cooperation.