• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Modify the VBA code To extract Column A & B Without repetition

H

Hany ali

Active Member
Dear My Master ,I Want Your Help To Extract Column A & Column B From all WorkBook Sheets To Summary Sheet Without repetition
Code: 
Sub GetNames()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long, C As Range
Dim LS As Long, p As Long, Obj As Object
Set Sh = Sheets("Summary")
LS = Sh.Range("B" & Rows.Count).End(2).Row
Sh.Range("B2:B" & LS) = ""
Set Obj = CreateObject("scripting.dictionary")
For Each ws In Worksheets(Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"))
If ws.Name <> Sh.Name Then
LR = ws.Range("B" & Rows.Count).End(2).Row - 1
For Each C In ws.Range("B2:B" & LR)
If Not IsEmpty(C) Then Obj(C & "") = ""
Next
End If
Next
Sh.Range("b2:B2").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys)
Call SumIf_Valus
End Sub
Sub SumIf_Valus()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long
Dim Arc As Variant, Arr As Variant
Dim LS As Long, j As Long, x As Double
Dim SupNam As String
Application.ScreenUpdating = False
Set Sh = Sheets("Summary")
LS = Sh.Range("B" & Rows.Count).End(3).Row
If LS < 2 Then LS = 2
Arc = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
Arr = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
j = 2
Do While j <= LS
SupNam = Sh.Range("B" & j)
For i = LBound(Arr) To UBound(Arr)
For Each ws In Worksheets(Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"))
LR = ws.Range("B" & Rows.Count).End(2).Row
If LR < 2 Then LR = 2
x = x + WorksheetFunction.SumIf(ws.Range("B2:B" & LR), SupNam, _
ws.Range(ws.Cells(2, Arr(i)), ws.Cells(LR, Arr(i))))
Sh.Range(Arc(i) & j) = x
Next
x = 0
Next
j = j + 1
Loop
Application.ScreenUpdating = True
End Sub
 

Attachments

  • Untitled.png
    Untitled.png
    115.1 KB · Views: 7
  • Profit.xlsb
    339.9 KB · Views: 6
Hi

Check this versionand let me know any challenges

Code: 
Sub ExtractData()
    Dim ws As Worksheet, Sh As Worksheet
    Dim LR As Long, i As Long, j As Long
    Dim Arc As Variant, Arr As Variant
    Dim LS As Long, x As Double
    Dim SupNam As String
    
    Application.ScreenUpdating = False
    
    Set Sh = Sheets("Summary")
    LS = Sh.Range("B" & Rows.Count).End(xlUp).Row
    
    If LS < 2 Then LS = 2
    
    Arc = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
    Arr = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
    
    For j = 2 To LS
        SupNam = Sh.Range("B" & j)
        For i = LBound(Arr) To UBound(Arr)
            x = 0
            For Each ws In Worksheets(Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"))
                LR = ws.Range("B" & Rows.Count).End(xlUp).Row
                If LR < 2 Then LR = 2
                x = x + Application.WorksheetFunction.SumIf(ws.Range("B2:B" & LR), SupNam, ws.Range(ws.Cells(2, Arr(i)), ws.Cells(LR, Arr(i))))
            Next ws
            Sh.Range(Arc(i) & j).Value = x
        Next i
    Next j
    
    Application.ScreenUpdating = True
End Sub
 
thanks alot ..But this code did not make any changes
and This is the exact desired result in the file
 

Attachments

  • Untitled.png
    Untitled.png
    31.1 KB · Views: 1
  • Profit.xlsb
    343.5 KB · Views: 6
Last edited:
Hello,​
​
this is a wild cross posting !​
According to Excel basics that should be done with a faster and shorter VBA procedure than your initial post gas factory …​
​
 
This was the work of one of my friends, and I cannot do more than that. I hope you can help me, as I need this file. It is very urgent. Thank you very much.
Thank you very much for your response
 
So your friend does not know Excel basics which should give you an instant result according to your attachment !​
What's wrong with 'your code' ?​
As you can easily manually solve this just copying all 'key' columns data to Summary sheet​
then just using Excel feature 'Remove duplicates' and so on, solved by a kid Excel beginner in less than 10 minutes …​
​
For more help : cross posting is allowed but you must at least post a link for every forum where you posted the same thread​
and do the same in each forum.​
​

A message to forum cross posters

Do you know why you're here? If you have been pointed to this page, it is not because someone is mad at you, but rather because we want to curb your posting habits before people start ignoring your posts. Online … Continue reading →
www.excelguru.ca www.excelguru.ca
​
As a reminder 'very urgent' does very not match with poor initial post explanation and attachment …​
​
 
I think I did not violate the rules of the forum. I am just asking for help if possible. Is this a violation? I have not raised this request elsewhere before.
But what has been uploaded is a different topic with a different file than this file

All I need is simply to transfer the data of all the Sheets of the file to Summary Sheet, so that the data is in the two columns A&B without Repetition, and the rest of the data of the other columns is collected according to the data of these two columns.As Result In The previous file that was uploaded
If I am not welcome in the forum, I am sorry, and I can withdraw from the forum silently and not repost it at all.and You Can Delete This Post
 

Attachments

  • Profit.xlsb
    354.9 KB · Views: 1
Last edited:
You have created the same thread on another forum - where you got your 'friend' code - so as requested post the link …​
​
And attach a well representative workbook with at least a couple of months​
- as for a single month there is nothing to do, just a single Copy codeline is necessary ‼ :rolleyes: -​
and the exact Summary expected result without any error …​
​
 
According to your thread title you can easily follow post #6 kid way just copying all data within Summary​
then just using the Excel feature 'Remove duplicates' if only your « extract without any repetition » means 'unique' …​
Once it works manually then just using the Macro Recorder to start your new code.​
​
For more help well read and follow at least posts #6, 8 and 10 …​
​
 
You must log in or register to reply here.
Back
Top