Hello and first let me say thank you!
I use Excel to capture user requirements and descriptions. I then take that information and clean it up and paste into presentation docs, apply formatting, paste into Powerpoint, etc. It can be 100s of lines in total that this is done for. What I’m looking for is a macro that I can apply to data once it is pasted into Excel. The data will be text, non-numeric
I have a macro that I use to insert a blank row as every other row. I then do everything else manually (macro shown below).
What I’m looking for is a macro that inserts a blank row, then offsets Column 2 by 1 row down. then pastes column 1 into column 2(without copying the blank cells over my already existing data in column 2).
I’ve pasted a link to an image of what I’m looking for. I’ve also tried to show below (numbers are column 1, letters are column 2).
Result I want:
My current “Blank Row” Macro:
Sub insertrow() ' insertrow Macro Application.ScreenUpdating = True Dim count As Integer Dim X As Integer For count = 1 To 300 If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Select Range(ActiveCell, ActiveCell.Offset(0, 0)).EntireRow.Insert ActiveCell.Offset(1, 0).Select For X = 1 To 1 Next X Else ActiveCell.Offset(1, 0).Range("a1").Select End If Next count End Sub
The following does what you need without inserting blank rows. It also calculates what the last row is on the sheet that has 2 columns so that you don’t need to hard-code when the loop will end.
The comments should help you understand what is happening each step of the way. You can then modify this to work with your particular workbook. There are a lot of ways you could go about this. I chose to put the pivoted result on a second sheet.
Sub PivotTwoColumnsIntoOne() Dim wb As Workbook Dim src As Worksheet Dim tgt As Worksheet Dim rng As Range Dim cell As Range Dim lastRow As Long Dim targetRow As Long Set wb = ThisWorkbook ' set our source worksheet Set src = wb.Sheets("Sheet1") ' set our target sheet (where the single column will be) Set tgt = wb.Sheets("Sheet2") ' get the last row on our target sheet lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row ' set the starting point for our target sheet targetRow = 1 Set rng = src.Range("A1:A" & lastRow) For Each cell In rng With tgt.Range("A" & targetRow) ' get the value from the first column .Value = cell.Value ' get the value from the second column .Offset(1).Value = cell.Offset(, 1).Value .HorizontalAlignment = xlLeft End With targetRow = targetRow + 2 Next cell End Sub
This should work, but you’ll have to adjust a little for your exact layout and needs.
Sub mergeColumns() Dim mergedData As Variant ReDim mergedData(1 To 600) dataToProcess = Range("A2:B301") For i = 1 To 300 mergedData(i * 2 - 1) = dataToProcess(i, 1) mergedData(i * 2) = dataToProcess(i, 2) Next i Range("B2:B601") = WorksheetFunction.Transpose(mergedData) End Sub