Posts by M40wen

M40wen · Jan 14th 2019

Hi Kenneth

so the process works as follows (it is for a builder who has multiple sites and plots).

The accountant spreadsheet gets dumped onto an input sheet
User presses a button to clean and then add into a data sheet automatically
if there is a new supplier, it adds this to a company sheet, and colours in the data sheet so the user will know it needs to fill in
when returning to the data sheet, there should be a drop down list only showing what is in the corresponding drop down

it all works well enough. However the user might want to change the set up, and hence why it needs to be sorted. My solution for this was to flag if the company or activity sheet is sorted, then to add back validations for the entire datasheet. It seemed overkill, but we are only talking a few thousand rows so better to be safe.

interesting that you said sorting the columns left to right works for you, it doesnt for me. The project endedup a few thousand lines of code so another dozen wasnt too arduous!

M40wen · Jan 10th 2019

Quote from Kenneth Hobson

Did you set a named range and used that?

Apologies I had trouble logging in and the site is very slow.

I recoded it to use named ranges - and found that it still does the same thing! It looks like if anything gets added to my set up table and then sorted alphabetically left to right, I will have to redo all the validations for all affected cells in the data sheet using those validation lists. Im also tempted t take out the named ranges again as I prefer to code in the cell refs. This really needs fixing by MS.

I guess the best way is to flag if something is going to be added (my code checks it is on the setup company or activity table), then if so not to do the validations as its importing in, but to wait till the end then rerun for all.

M40wen · Jan 9th 2019

Hi all,

I currently have a list of companies in the first row, and activities underneath for each company. This is then used as a data validation for cells. However, if I add a company in, then sort left to right, the existing data validation doesn't update with the new sorted address... Do I need to recode and update every drop down if I do a sort? Reason being my client likes to look at the company activities and wishes to view it (my code just added on end then sorted - but now causes this problem). I would say this is a bug that needs fixing because if you are sorting the "validation list", then the validations should update accordingly. Have I missed a trick here? I thought that by removing the $ the validation would work but it doesn't - though if I add or remove a column the validation works correctly (so why not sort MS)

Any help or ideas?

M40wen · Sep 7th 2018

It might be worth adding an OR statement and using CLEAN/TRIM.... Ive seen sheets that had some noise in before which messed a similar routine up.

M40wen · Oct 11th 2017

Sorry ignore, the answer is

=INDIRECT("'"&B5&"'!C"&MATCH("Total Actual Retail/Revenue.",INDIRECT("'"&B5&"'!B:B"),0)&"")-D5

M40wen · Oct 11th 2017

Hello,

Im having trouble with this formula

=INDIRECT("'"&B5&"'!C"&MATCH("Total Actual Retail/Revenue.",'2221866'!B:B,0)&"")-D5

I just want the '2221866' To be referenced to Cell B5 (like at the start), but I cant seem to get the right notation. Can someone urgently help me?

M40wen · Sep 13th 2017

Re: VBA to compare the column in text file and return in the excel file

Import the txt file into a sheet, then do the compare all in excel.

Have to say for a beginner, its abit more fancy than normal using arrays!

M40wen · Sep 6th 2017

Re: VBA for PIVOT filter to remove blanks and zero values from Filter

Are there any zeros or blanks in your pivot item list though? If there isn't, there is no pivot item to hide. Can you check your data?

M40wen · Jun 20th 2017

Re: Reorder Columns Based on Headers

Don't worry, it was tongue in cheek!

M40wen · Jun 6th 2017

Re: vba to insert a blank row at a change in value in col 3 only if not divisble by 8

Ahh I see - you aren't changing anything in the column, its the data value that's changing. QQ:-

Is column C sorted already?

Do you have headers?

Does data start in row 2?

What is the name of the sheet this process is on (I prefer to ref the sheet directly that's all)

For the data, which column is the last data set in? Will it always be populated or is there blank details (im trying to identify what your last row of your data range is in)

M40wen · Jun 6th 2017

Re: vba to insert a blank row at a change in value in col 3 only if not divisble by 8

No, you don't need to run it - you need to make a change in column 3 (ie column C) on that sheet. The code is saying if you make a change in Column C, and the row changed is divisible by 8 or not, then insert lines...

Try it..

M40wen · Jun 6th 2017

Re: vba to insert a blank row at a change in value in col 3 only if not divisble by 8

The sheet you want that code to execute from, it needs to be there rather than a module. Its difficult to know about your current code as id have to see it all...

M40wen · Jun 5th 2017

Re: vba to insert a blank row at a change in value in col 3 only if not divisble by 8

This need to go in the sheet code

Code

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'written by [EMAIL="[email protected]"][email protected][/EMAIL]
if target.column = 3 then


If Target.Row - 1 Mod 8 = 0 Then
'divisible by 8 so do nothing - change if you need
Else
'not divisible by 8
Application.EnableEvents = False
Rows(Target.Row - 1 & ":" & Target.Row - 1 + (8 - Target.Row - 1 Mod 8)).EntireRow.Insert
Application.EnableEvents = True
End If


end if


End Sub

Display More

M40wen · May 22nd 2017

Re: Reorder Columns Based on Headers

I think you may find this approach more helpful - you've expired on the goodwill with me!

Code

Option Explicit
Dim wsSheet As Worksheet
Dim Rng As Range, CellRange As Range
Dim SrchHorse As Long
Dim Sheet1Time As Long, Sheet1Horse As Long, Sheet1Age As Long, Sheet1Weightpounds As Long, Sheet1Penalty As Long, Sheet1WeightRank As Long, Sheet1DSLR As Long, Sheet1FormString As Long, Sheet1PaceString As Long, Sheet1PaceRating As Long
Dim Sheet2Horse As Long, Sheet2Age As Long, Sheet2DSLR As Long, Sheet2RunsBefore As Long, Sheet2WonBefore As Long, Sheet2PlcBefore As Long, Sheet2HACareer As Long
Dim Sheet1LstRw As Long, Sheet1LstCl As Long, Sheet2LstRw As Long, Sheet2LstCl As Long, rw As Long
Sub xample()
'Code written by [EMAIL="[email protected]"][email protected][/EMAIL]
Set wsSheet = Nothing
On Error Resume Next
Set wsSheet = ThisWorkbook.Sheets("Sheet1")
On Error GoTo 0
If wsSheet Is Nothing Then
MsgBox "Sheet1 doesnt exist"
End If
Set wsSheet = Nothing
On Error Resume Next
Set wsSheet = ThisWorkbook.Sheets("Sheet2")
On Error GoTo 0
If wsSheet Is Nothing Then
MsgBox "Sheet2 doesnt exist"
End If
'check if Combined sheet exists, if not create it
Set wsSheet = Nothing
On Error Resume Next
Set wsSheet = ThisWorkbook.Sheets("Combined")
On Error GoTo 0
If Not wsSheet Is Nothing Then
Else
ThisWorkbook.Sheets.Add.Name = "Combined"
End If
If ThisWorkbook.Sheets("Combined").AutoFilterMode Then
ThisWorkbook.Sheets("Combined").AutoFilterMode = False
End If
On Error Resume Next
ThisWorkbook.Sheets("Combined").ShowAllData
On Error GoTo 0
ThisWorkbook.Sheets("Combined").Cells.Clear
ThisWorkbook.Sheets("Combined").Cells.Delete


'this bit is setting the range
On Error Resume Next
Set Rng = Range(ThisWorkbook.Sheets("Sheet1").Cells(2, 2), ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count, 2))
On Error GoTo 0
'check that the range is something
If Rng Is Nothing Then
MsgBox "There are no boats!"
Exit Sub
End If


'now we know everything is what it should be, create the sheet. This stipulates the headers. You can go for fixed ranges, but this will aloow you to individually adjust
ThisWorkbook.Sheets("Combined").Cells(1, 1) = "Time"
ThisWorkbook.Sheets("Combined").Cells(1, 2) = "Horse"
ThisWorkbook.Sheets("Combined").Cells(1, 3) = "Age"
ThisWorkbook.Sheets("Combined").Cells(1, 4) = "Weight (pounds)"
ThisWorkbook.Sheets("Combined").Cells(1, 5) = "Penalty"
ThisWorkbook.Sheets("Combined").Cells(1, 6) = "Weight Rank"
ThisWorkbook.Sheets("Combined").Cells(1, 7) = "DSLR"
ThisWorkbook.Sheets("Combined").Cells(1, 8) = "Form String"
ThisWorkbook.Sheets("Combined").Cells(1, 9) = "Pace String"
ThisWorkbook.Sheets("Combined").Cells(1, 10) = "Pace Rating"
ThisWorkbook.Sheets("Combined").Cells(1, 11) = "Horse"
ThisWorkbook.Sheets("Combined").Cells(1, 12) = "Age "
ThisWorkbook.Sheets("Combined").Cells(1, 13) = "DSLR"
ThisWorkbook.Sheets("Combined").Cells(1, 14) = "Runs Before"
ThisWorkbook.Sheets("Combined").Cells(1, 15) = "Won Before"
ThisWorkbook.Sheets("Combined").Cells(1, 16) = "Plc Before"
ThisWorkbook.Sheets("Combined").Cells(1, 17) = "HA Career"
'these are all the variables
Sheet1LstRw = ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count
Sheet1LstCl = ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count
Sheet2LstRw = ThisWorkbook.Sheets("Sheet2").UsedRange.Rows.Count
Sheet2LstCl = ThisWorkbook.Sheets("Sheet2").UsedRange.Columns.Count


Sheet1Time = 0
On Error Resume Next
Sheet1Time = Application.Match("Time", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Time = "0" Then
MsgBox "I cannot find Time in the first row on sheet1"
End
End If
Sheet1Horse = 0
On Error Resume Next
Sheet1Horse = Application.Match("Horse", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Horse = "0" Then
MsgBox "I cannot find Horse in the first row on sheet1"
End
End If
Sheet1Age = 0
On Error Resume Next
Sheet1Age = Application.Match("Age", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Age = "0" Then
MsgBox "I cannot find Age in the first row on sheet1"
End
End If
Sheet1Weightpounds = 0
On Error Resume Next
Sheet1Weightpounds = Application.Match("Weight (pounds)", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Weightpounds = "0" Then
MsgBox "I cannot find Age in the first row on sheet1"
End
End If
Sheet1Penalty = 0
On Error Resume Next
Sheet1Penalty = Application.Match("Penalty", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Penalty = "0" Then
MsgBox "I cannot find Penalty in the first row on sheet1"
End
End If
Sheet1WeightRank = 0
On Error Resume Next
Sheet1WeightRank = Application.Match("Weight Rank", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1WeightRank = "0" Then
MsgBox "I cannot find Age in the first row on sheet1"
End
End If
Sheet1DSLR = 0
On Error Resume Next
Sheet1DSLR = Application.Match("DSLR", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1DSLR = "0" Then
MsgBox "I cannot find DSLR in the first row on sheet1"
End
End If
Sheet1FormString = 0
On Error Resume Next
Sheet1FormString = Application.Match("Form String", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1FormString = "0" Then
MsgBox "I cannot find Form String in the first row on sheet1"
End
End If
Sheet1PaceString = 0
On Error Resume Next
Sheet1PaceString = Application.Match("Pace String", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1PaceString = "0" Then
MsgBox "I cannot find Pace String in the first row on sheet1"
End
End If
Sheet1Weightpounds = 0
On Error Resume Next
Sheet1Weightpounds = Application.Match("Weight (pounds)", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Weightpounds = "0" Then
MsgBox "I cannot find Weight (pounds) in the first row on sheet1"
End
End If
Sheet1PaceRating = 0
On Error Resume Next
Sheet1PaceRating = Application.Match("Pace Rating", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1PaceRating = "0" Then
MsgBox "I cannot find Pace Rating in the first row on sheet1"
End
End If
Sheet2Horse = 0
On Error Resume Next
Sheet2Horse = Application.Match("Horse", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2Horse = "0" Then
MsgBox "I cannot find Horse in the first row on sheet2"
End
End If
Sheet2Age = 0
On Error Resume Next
Sheet2Age = Application.Match("Age", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2Age = "0" Then
MsgBox "I cannot find Age in the first row on sheet2"
End
End If
Sheet2DSLR = 0
On Error Resume Next
Sheet2DSLR = Application.Match("DSLR", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2DSLR = "0" Then
MsgBox "I cannot find DSLR in the first row on sheet2"
End
End If
Sheet2RunsBefore = 0
On Error Resume Next
Sheet2RunsBefore = Application.Match("Runs Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2RunsBefore = "0" Then
MsgBox "I cannot find Runs Before in the first row on sheet2"
End
End If
Sheet2PlcBefore = 0
On Error Resume Next
Sheet2PlcBefore = Application.Match("Plc Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2PlcBefore = "0" Then
MsgBox "I cannot find Plc Before in the first row on sheet2"
End
End If
Sheet2WonBefore = 0
On Error Resume Next
Sheet2WonBefore = Application.Match("Won Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2WonBefore = "0" Then
MsgBox "I cannot find Won Before in the first row on sheet2"
End
End If
Sheet2HACareer = 0
On Error Resume Next
Sheet2HACareer = Application.Match("HA Career", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2HACareer = "0" Then
MsgBox "I cannot find HA Career in the first row on sheet2"
End
End If


'you know everything exists, so now build your report
'Set the start rw as 2
rw = 2
For Each CellRange In Rng
SrchHorse = 0
On Error Resume Next
SrchHorse = Application.Match(ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Horse), Range(ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2Horse), ThisWorkbook.Sheets("Sheet2").Cells(Sheet2LstRw, Sheet2Horse)), 0)
On Error GoTo 0
If SrchHorse = "0" Then
'it doesn't exist so what should you do
Else
'its found
ThisWorkbook.Sheets("Combined").Cells(rw, 1).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Time).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 2).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Horse).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 3).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Age).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 4).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Weightpounds).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 5).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Penalty).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 6).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1WeightRank).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 7).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1DSLR).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 8).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1FormString).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 9).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1PaceString).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 10).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1PaceRating).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 11).Value = ThisWorkbook.Sheets("Sheet2").Cells(CellRange.Row, Sheet2Horse).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 12).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2Age).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 13).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2DSLR).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 14).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2RunsBefore).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 15).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2WonBefore).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 16).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2PlcBefore).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 17).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2HACareer).Value
'need to offset for the next row
rw = rw + 1
End If


'next cell in your range
Next CellRange
'tidy the formats
ThisWorkbook.Sheets("Combined").Columns(1).NumberFormat = "hh:mm:ss"
 
End Sub

Display More

M40wen · May 16th 2017

Re: scan and copy top 10 values using vba

A bit quick and dirty but... You may need to adjust the range if your data is actually bigger than two columns otherwise you will be sorting a partial data set. Let me know if im a legend

Code

Option Explicit
Dim actLastRw As Long
Dim actSheet As String
Sub MyTop10()
   
actSheet = ActiveSheet.Name
'Switch off any filters
On Error Resume Next
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
ActiveSheet.ShowAllData
On Error GoTo 0
Rows("1:1").Select
Selection.AutoFilter
'need to find last row
actLastRw = ThisWorkbook.Sheets(actSheet).Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ThisWorkbook.Worksheets(actSheet).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(actSheet).Sort.SortFields.Add Key:=Range("C1"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B2:C" & actLastRw)      ' you need to ensure its the full range, but youve said only b and c have data so...
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
' must clear again - if you dont you will run into a corrupt sheet at some point
ThisWorkbook.Worksheets(actSheet).Sort.SortFields.Clear
'now know that the top ten are at the top
Range(ThisWorkbook.Sheets(actSheet).Cells(1, 5), ThisWorkbook.Sheets(actSheet).Cells(11, 5)).Value = Range(ThisWorkbook.Sheets(actSheet).Cells(1, 3), ThisWorkbook.Sheets(actSheet).Cells(11, 3)).Value
Range(ThisWorkbook.Sheets(actSheet).Cells(1, 6), ThisWorkbook.Sheets(actSheet).Cells(11, 6)).Value = Range(ThisWorkbook.Sheets(actSheet).Cells(1, 2), ThisWorkbook.Sheets(actSheet).Cells(11, 2)).Value
 


End Sub

Display More

M40wen · May 16th 2017

Re: Random Slow Down Of Text Import

Ok so after MUCH head scratching....

This macro is part of 5 files that get imported (the code is more or less the same with just a few tweaks). The issue is the parsing text to columns - now I have no idea why its an issue but can only assume something is getting held in memory which randomly slows down the next file (and again it is random). So ive given up on trying to understand why, but what I have found is if you remove the text to columns, and instead import all the text files THEN run the text to columns together, I get NO slowdown, and the files are consistently running (in my case under 3 mins for 10 files/sheets in total over around 1.5 million rows). I don't understand why running the macro a second time has no slowdown, so if anyone can "explain" that to me id be grateful, but for now ive tested this out over a dozen times and we are looking good ... Hope this helps someone else.

M40wen · May 15th 2017

Re: scan and copy top 10 values using vba

Why not sort by column C descending, then copy the first ten rows? If it ssorted it will always be the top 10 rows (or rows 2-11 if a header)

M40wen · May 15th 2017

Re: Reorder Columns Based on Headers

Code

For i = 1 To lc 
    On Error Resume Next 
    Fnd = 0 
    fnd = Sheet2.Rows(1).Find(Ar(1, i)).Column 
    On Error Goto 0 
    If Fnd <> 0 Then 
        Sheet2.Columns(fnd).Copy Sheet3.Cells(1, i) 
    else
        Sheet3.cells(1, i)= Sheet1.cells(1,i)
    End If 
Next I

Display More

M40wen · May 15th 2017

Re: Reorder Columns Based on Headers

Amend code above, basically it will only copy it if it finds it, else it finds next one..

Code

For i = 1 To lc 
on error resume next
Fnd = 0
fnd = Sheet2.Rows(1).Find(Ar(1, i)).Column 
on error goto 0
If Fnd <> 0 Then
Sheet2.Columns(fnd).Copy Sheet3.Cells(1, i) 
 end if
    Next I

M40wen · May 15th 2017

Re: Reorder Columns Based on Headers

For i = 1 To lc
on error resume next
Fnd = 0
fnd = Sheet2.Rows(1).Find(Ar(1, i)).Column
on error goto 0
If Fnd <> 0 Then
Sheet2.Columns(fnd).Copy Sheet3.Cells(1, i)
end if
Next i

Posts by M40wen

Data Validation List and sorting

Data Validation List and sorting

Data Validation List and sorting

For Each seems stuck on spot

Indirect Match Formula

Indirect Match Formula

VBA to compare the column in text file and return in the excel file

VBA for PIVOT filter to remove blanks and zero values from Filter

Reorder Columns Based on Headers

vba to insert a blank row at a change in value in col 3 only if not divisble by 8

vba to insert a blank row at a change in value in col 3 only if not divisble by 8

vba to insert a blank row at a change in value in col 3 only if not divisble by 8

vba to insert a blank row at a change in value in col 3 only if not divisble by 8

Reorder Columns Based on Headers

scan and copy top 10 values using vba

Random Slow Down Of Text Import

scan and copy top 10 values using vba

Reorder Columns Based on Headers

Reorder Columns Based on Headers

Reorder Columns Based on Headers