Help Renaming Columns then Rearranging order and adding additional columns

rickadams

New Member
Joined
Feb 11, 2018
Messages
32
This is a Great site, Thank you! To start with I am working with Microsoft Excel 2010 Pro

I am new at this, however I have used a few VBA scripts in excel 2010

We have multiple door entry systems that I have been graced with setting up by May.
The data is required needs to be in a different order and requires additional columns, so I am attempting to start this project now.

I would like to have a script to change what I am calling the column title data saved in A1,B1,Etc all the way up to F1 without goofing up the rest of the data in those columns.

A1 has the value of "Lease Agreement - Unit - Address" However it needs to only show "Street"
B1 has the value of "Unit City / State / Zip" It needs to only show "City"
C1 has the value of "Student First Name" It needs to only show "First Name"
D1 has the value of "Student - Last Name" It needs to only show " Last Name"
E1 has the value of "Email" It needs to show as "Custom Type 1"
F1 has the value of "Cell Phone Number" It needs to show "HomePhone"

I am looking for a script to easily rename all of the titles across the top.

Then I need to Move the order around and Add New Columns with additional Titles up to X1
So If there is a way to Add Columns at the same time as the rename and move the columns too that would be great...

I think if someone could get me started in the right direction, I might be able to continue the rest on my own.

Then the new A1 would be come"UserID" And the data that was in A1 needs to go to C1, along with additional changes.

I am looking for a script because the data in these 8 entry systems has to be changed all the time and there can be up to 400 tenants per system.
Also the spreadsheet that I download from the web page only allows .CSV downloads, can it be renamed and saved as .XLSX using the sane script?
To top it all off I will need to export these modified sheets as Ms Access 2003 .MDB format because that is what the entry systems understand. Uggh

Thank you In Advance.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Rick, Your script rearranging the Columns worked perfectly for me. Thank you so much!!!
The last thing I need help with a VBA to Fill in the blanks created so the LastEventlog in Column L needs to be numeric 0 from L2 all the way down to the bottom of the entries I have. Then ExpirationDate In Column M needs to be the exact date of 01/01/1900 all the way to the bottom of the entries (I think that is where the next Column comes in) NeverExpires TRUE. Then the data in Columns O Thru T need to be the value of FALSE To the last row of data.

I want to thank you again Rick for your help!!! and for replying so quickly! I did get a bit mixed up in my replies. Sorry about that...

Unrelated It is very foggy here and there was a bad MVA in front of my house, SUV Vs Tree. I've been told everyone is Ok.
 
Upvote 0
Fluff Thank you for your help!

I just wish I learned as much about VBA as I could when I was younger. I understand some of the coding everyone sent. VBA coding is somewhat Similar to the MSBasic I learned back in the 70's. Unfortunately I did not follow through like I should have.
 
Upvote 0
Rick, Your script rearranging the Columns worked perfectly for me. Thank you so much!!!
The last thing I need help with a VBA to Fill in the blanks created so the LastEventlog in Column L needs to be numeric 0 from L2 all the way down to the bottom of the entries I have. Then ExpirationDate In Column M needs to be the exact date of 01/01/1900 all the way to the bottom of the entries (I think that is where the next Column comes in) NeverExpires TRUE. Then the data in Columns O Thru T need to be the value of FALSE To the last row of data.
Here is the code I posted, modified to do that...
Code:
[table="width: 500"]
[tr]
	[td]Sub RearrangeColumns()
  Dim X As Long, LastRow As Long, Letters As Variant, NewLetters As Variant
  Const NewOrder As String = "G,H,C,D,I,A,B,J,K,F,L,M,N,O,P,Q,R,S,T,U,E,V,W,X"
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  Letters = Split(NewOrder, ",")
  ReDim NewLetters(1 To UBound(Letters) + 1)
  For X = 0 To UBound(Letters)
    NewLetters(X + 1) = Columns(Letters(X)).Column
  Next
  Range("A1").Resize(LastRow, UBound(Letters) + 1) = Application.Index(Cells, Evaluate("ROW(1:" & LastRow & ")"), NewLetters)
  Range("L2:L" & LastRow) = 0
  Range("M2:M" & LastRow) = DateSerial(1900, 1, 1)
  Range("N2:N" & LastRow) = True
  Range("O2:T" & LastRow) = False
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Here is the final code that does everything I need the code to do>..
Code:
Sub RearrangeColumns()
' First we clear out the unneeded data


Range("G1:U1000").ClearContents
'Then we autofit the Columns


ActiveSheet.Range("A1:G1").EntireColumn.AutoFit
' Now we add the correct headings


Range("A1:F1") = Array("Street", "City", "First Name", "Last Name", "Custom Type 1", "HomePhone")
' Now we arrange the columns in the proper order for AcessBase2000 export


  Dim X As Long, LastRow As Long, Letters As Variant, NewLetters As Variant
  Const NewOrder As String = "G,H,C,D,I,A,B,J,K,F,L,M,N,O,P,Q,R,S,T,U,E,V,W,X"
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  Letters = Split(NewOrder, ",")
  ReDim NewLetters(1 To UBound(Letters) + 1)
  For X = 0 To UBound(Letters)
    NewLetters(X + 1) = Columns(Letters(X)).Column
  Next
  Range("A1").Resize(LastRow, UBound(Letters) + 1) = Application.Index(Cells, Evaluate("ROW(1:" & LastRow & ")"), NewLetters)


' Now we add the required data and change the CZS
  
  Range("L2:L" & LastRow) = 0
  Range("M2:M" & LastRow) = DateSerial(1900, 1, 1)
  Range("N2:N" & LastRow) = True
  Range("O2:T" & LastRow) = False
  Range("G2:I" & LastRow) = Array("B######", "17###", "PA")
  
' This sets the L collumn to be numeric
   Range("L1:L1000").Select
    Selection.NumberFormat = "0"


' This adds the correct headers to the Top Row
 
Range("A1:X1") = Array("UserID", " CHSetIndex", "FirstName", "LastName", "MiddleName", " Street", "City", "Zip", "State", "HomePhone", "Workphone", "LastEventLog", "ExpirationDate", "NeverExpires", "Active", "Deleted", "GotTransmitters", "GotCards", "GotEntryCodes", "GotEnrtyNumbers", "CustomType 1", " CustomType 2", " CustomType 3", " CustomType 4")
ActiveSheet.Range("A1:Y1").EntireColumn.AutoFit


' This first makes sure Autofilter is off then turns on the Autofilter for all the Columns we are using.
ActiveSheet.AutoFilterMode = False
Range("A1:X1").AutoFilter


End Sub


Rick,
I Think this is a close as I am going to get... Thank you so much for your help!!!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,194
Members
453,021
Latest member
pingpong7117

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top