Posts by mythu

Can someone please help me on this. I would appreciate your help.

Alright Thank you very much.

Sir Thank you very much but i am looking for the same solution in VBA. I would appreciate if you can do something.

There are multiple Workbooks in a folder and have similar column which Header name is "Name" but in each file column position is chnaged.

I want to search that header in 1st row of each workbook if finds then copy that entire column from multiple workbooks availble in Folder and Paste Unique result (values) into an open workbook where from code is being run.

There is one more thing that i want to extract multiple column by Header please add Array method so i can add more column name. I have attached 3 workbooks and result file

I would appreciate your help.

Sub MultipleSimilarColinto_1()
 
    Dim xFd         As FileDialog
    Dim xFdItem     As String
    Dim xFileName   As String
    Dim wbk         As Workbook
    Dim sht         As Worksheet
    Dim twb         As Workbook
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim desWS As Worksheet
    Dim colArr As Variant
    Dim order As Long
    Dim i As Long

    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ActiveWindow.View = xlNormalView
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    Set twb = ActiveWorkbook
    Set desWS = twb.Sheets("Sheet1")
    If xFd.Show Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    Else
        Beep
        Exit Sub
    End If
    xFileName = Dir(xFdItem & "*.xlsx")
    Do While xFileName <> ""
        
        Set wbk = Workbooks.Open(xFdItem & xFileName)
colArr = Array("Name")
        
        For Each ws In wbk.Sheets
            
            If ws.Name <> "Sheet1" Then
            
            LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            
            For i = LBound(colArr) To UBound(colArr)
                    order = ws.Rows(1).Find("Name", LookIn:=xlValues, lookat:=xlWhole).Column
                    ws.Range(ws.Cells(2, order), ws.Cells(LastRow, order)).Copy desWS.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            Next i
        End If
            
        Next ws
        wbk.Close SaveChanges:=True
        xFileName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Thank you very much for the assistance gijsmo

gijsmo I like the way you wrote this code and formula but both are extremly slow even then mine above code. I have more than 350K rows wit the a lot data. Where every function goes slow.

I appreciate your help.

KjBox Is there any solution that you can provide or modify the above mine code to calculate accurate result. I do not want to remove the 0 from start of the string i need to keep these zero.

The problem is simple COUNTIF answers are wrong with the above attached data, which forced me to move with the code.

Yes you're right COUNTIF is more faster than VBA but that time COUNTIF is not giving an accurate answer. You can try on attached file.

First i used COUNTIF then SUMPRODUCT since countif answers were wrong then went to sumproduct which was perfect but its processing were slow over large datasets.

Then found above code. I would appreciate if you could help to modify the above code.

I am using CountIF VBA version which gives me ease due to its fast calculation while working with the large datasets. My Data has text values as well as numerice values so it is basicaly a combination of different values.

I just want to count the number of repeated values but my function is giving wrong result as you can see in attached file.

I would appreciate if someoene can look into it and make it more efficent in terms of:

Accurate count for repeated values

Code Speed

and the last thing is i want to use this code in Personal.XLSB so i can recall it using shortkey.

I hope to get help. Thanks

I did it thank you very much.

I understand but if it can be done even later. I would apreciate it. Otherwise no problem and thank you for being so nice

Thank you. Its opening the Calendar now but not writing the Dates. I would appreciate if you could resolve this too.

I want to call this calender in column A by pressing double click but do not know how to call. I would really appreciate you help thanks.

Thank you very much you corrected the mistake.

I have been trying to match the values with vlookup and after that summed up.

My formula is working well but an error is appear in last highlighted cells .

Any help will be appreciated

I have been using these two codes CellVal and Private Sub Worksheet_Change(ByVal Target As Range)

When i run the code CellVal that updates the next ID in the Sheets("Sheet1").Range("B6") if B6 is empty then it loads the first ID and set a trigger on cell B6 for second code, that whenever that cell is update second code is run.

Explaining second code

when 1st ID is load in Cell B6 then second code runs and copy the Sheet2.Range(B4) and Paste into Sheet3.Range(B4)

When 2nd ID is load in Cell B6 then second code runs and copy the Sheet2.Range(B4) and Paste into Sheet3.Range(C4)

When 3rd ID is load in Cell B6 then second code runs and copy the Sheet2.Range(B4) and Paste into Sheet3.Range(D4)

same for 4th and 5th and 6th and 7th`and 8th

Now the problem is that i run the code 8th times to load the next ID in Sheets("Sheet1").Range("B6") I want a help that How to set a trigger for code CellVal in sheet3 that ID will update automatically. If it got resolved then i have to run the code one time to update all values one by one rather than running the code 8th times.

Any help will be appreciated.

Sub CellVal()
If Sheet3.Range("B4") = 0 Then
Sheet3.Range("B4") = ""
End If
Dim sht1 As Worksheet, lastR As Long, rng As Range
Dim ECell As Range, cExist As Range, i As Long
Application.ScreenUpdating = False
Set sht1 = Sheets("Sheet1")
Set ECell = sht1.Range("B6")
lastR = sht1.Range("C" & sht1.Rows.Count).End(xlUp).Row
Set rng = sht1.Range("C27:C" & lastR)


If ECell.Value = "" Then
ECell.Value = rng.SpecialCells(xlCellTypeConstants).Areas(1).Value
Else
Set cExist = rng.Find(What:=ECell.Value, After:=rng.Cells(1), _
LookAt:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByRows)
If Not cExist Is Nothing Then
For i = 1 To lastR - cExist.Row
If cExist.Offset(i).Value <> "" Then
ECell.Value = cExist.Offset(i).Value
Exit For
End If
Next i
End If
End If
Application.ScreenUpdating = True
End Sub






Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$6" Then
Application.ScreenUpdating = False
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim col As Long
Set sht2 = Sheets("Sheet2")
Set sht3 = Sheets("Sheet3")
col = sht3.Cells(4, sht3.Columns.Count).End(xlToLeft).Column + 1
If col = 3 Then
sht2.Cells(4, 17).copy
Else
sht2.Cells(4, 2).copy
End If
sht3.Cells(4, col).PasteSpecial xlPasteValues
End If
Application.ScreenUpdating = True
End Sub

Thank you once again rory it is exactly what i have been looking for.

Thank you very much rory for sure Arrays are better. But second issue is still exists that if i run the Module1 code the result comes with error #VALUE! rather than output.

I.

Dim lastfor As Long
Application.ScreenUpdating = False
lastfor = Sheet2.Cells(Rows.Count, 148).End(xlUp).Row

Sheet2.Range("ES3").Formula2 = _
"=ConcatStringConditional(R2C140:R10000C140,RC[-1],R2C142:R10000C142)"
Sheet2.Range("ES3").AutoFill Destination:=Sheet2.Range("ES3:ES" & lastfor), Type:=xlFillDefault

Sheet2.Range("ET3").Formula2 = _
"=ConcatStringConditional(R2C140:R10000C140,RC[-2],R2C141:R10000C141)"
Sheet2.Range("ET3").AutoFill Destination:=Sheet2.Range("ET3:ET" & lastfor), Type:=xlFillDefault
Application.ScreenUpdating = True

I have a problem, hopefully someone may be able to help. I have been using MS Office 2016 wherein TEXTJOIN function does not work so i have added EXCEL UDF Function to make it work like TEXTJOIN works.

Here is the formula

ConcatStringConditional($EJ$2:$EJ$10000,ER3,$EL$2:$EL$10000)

I have pasted this formula through VBA but it returns with an error that is #VALUE! I have attached a file below wherein UDF and VBA formula both codes are available.

The code is extremely slow and is it possible to convert this below range into used range like we mostly used lastfor = Sheet2.Cells(Rows.Count, 148).End(xlUp).Row might speed could be better this way if i am not wrong.

$EJ$10000

I will really appreciate the help.

Thank you very much Carim i will amend it according to my needs.