Required VBA codes to transpose datas or value from a sheet

[PRADEEPB270]

Good Morning Hans,

Please help me to provide the VBA codes working ( Macro ) ,to transpose the datas or values from a sheet to relevant sheets.

Request you to please refer my attach file for more clarification.

I want a perfect macro working through VBA codes to solve my following complications:-

In this attach file,Refer the sheet names ending with '-D' or '-E' For an example,take a sheet i.e.'CNDKDRKCC-D' thenafter point i.e.'Col.H' and match both the conditions from the worksheet i.e.'Working for Proforma''and put the matching value either in col.E or col.F according to point no.in col.H.

Take a example,
Sheet name-CNDDRKCC-D
Point-Point-17 ( Cell NO.H50)
now the value of cell no.'E50'should be come from 'working for proforma'i.e.38,664,231.73.
For this both conditions matching,refer cell no.B64 i.e.Sheet name and cell no.P2 i.e.'Point-17' and put the value of cell no.P64 to sheet name 'CNDDRKCC-D'.

Can it be possible on all the sheets having ending with '-D' or '-E'?

[HansV]

It's impossible to fulfill your very demanding request. The sheets CNDKDRKCC-D etc. have values such as Point-91, Point-92 etc. that cannot be found on the Working for Proforma sheet, so we can't find a matching value.

[Rudi]

If you paste the following formula into cell E50 on the CNDKDRKCC-D sheet, it will place the value into the cell (then autofill):

Code: Select all

=IFERROR(INDEX('Working for Proforma'!$A$1:$AL$157,MATCH(RIGHT(CELL("filename",$A$1),LEN(CELL("filename",$A$1))-SEARCH("]",CELL("filename",$A$1))),'Working for Proforma'!$B:$B,0),MATCH($H50,'Working for Proforma'!$2:$2,0)),"")

Note: Not all rows will get matched because of missing or inconsistent data...

[PRADEEPB270]

Hans sir,if there is no value such as Point-91 and Point-92 found on the sheet 'working for proforma',then,it may be left out or ignore.Only those value could be taken when both the conditions met out.For an example,if Point-91 is appearing on sheet 'CNDKDRKCC-D' and it is not appearing in sheet 'working for proforma',then,no value should come on the sheet 'CNDKDRKCC-D'.Yes,you may take an alternative ,put all the matching value in the column 'I'instead of col.E or F.It means all values should come in the next column of 'Point' i.e.col.'I',whether the value is 'Zero' or having values'

[HansV]

See if this macro does what you want - test carefully.

Code: Select all

Sub LookupValues()
    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 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
            lngPointRow = wshOther.Cells(lngPointRow, 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, 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
                lngPointRow = lngPointRow + 1
                strPoint = wshOther.Cells(lngPointRow, lngPointCol).Value
            Loop
        End If
    Next wshOther
    Application.ScreenUpdating = True
End Sub

[PRADEEPB270]

Hi Hans Sir,
Good Morning and have a nice day.

Please refer my attach file for some propose correction which has left .

1-Refer the col.K in both sheets-CND....-D and -E.As and when difference appear,I have mark that cell with 'Red' colour font.
2-Refer the Col.'L'which is the correct result to remove the diff.of Col.K in case of only red colour font.
3-Refer the col.'M' for your quick reference.

Request you to please have a look once again and if possible,please remove the some minor errors so that result may be goal oriented.

[HansV]

Hi Pradeep,

These problems are too complicated to solve.

[PRADEEPB270]

Hi Hans,

I am full of beleive that only you can solve this problem.Because you are the GOD in the excel as i have felt in the past 7 years experience.

[HansV]

Pradeep, the layout of the 'Working with Proformas' sheet is too complicated, with the point-nn values spread out over different tables.

[PRADEEPB270]

Hans sir,can you solve only three points i.e.Point-62,71 and 75 because these are repeating twice or thrice times ? Point-94,99 and 100 I will manage treat as manual working.

[HansV]

It would take me too much time.

[PRADEEPB270]

Thank you sir,I will wait for your response.

[HansV]

Please understand: I won't work on this problem because it's too time-consuming.

[PRADEEPB270]

Thank you sir.Let it be.But hope you are always with me because we are as you are.