Find next blank column with Macro

[Guest]

Hi Guys

I have a question you may find a bit daft but it has me stumped.

I have a macro that finds the data I am looking for and pastes it into a new
worksheet ok but what I would like it to do is look along the columns and
find the next blank column and paste the data there so that with each paste
the macro will paste the new data into the next blank available column.

so first past will be in column A, then next paste in column B then next in
C and so on I have this code at the moment but all it does is find the same
column and over write the data that is already there

Dim LastCol As Long

LastCol = Sheets("Finds").Range("IV1").End(xlToLeft).Offset(0, 1).Column

Ive searched through all the posts and have found it very very helpful for
other things but cant find anything on this

Thanks for you help in advance

SAMIJLeeds (West Yorkshire, UK)

 

[Don Guillett]

you might like this better
LastCol = Sheets("Finds").cells(1,columns.count).End(xlToLeft).Column+1

 

[Chip Pearson]

Try some code like the following:

Sub AAA()

Dim WS As Worksheet
Dim WhatRow As Long
Dim FirstUnusedColumnNum As Long
Dim FirstUnusedColumnRng As Range

Set WS = Worksheets("Sheet1") '<<<< CHANGE AS DESIRED
WhatRow = 1 '<<<< CHANGE AS DESIRED
With WS
Set FirstUnusedColumnRng = .Cells(WhatRow,
..Columns.Count).End(xlToLeft)
If FirstUnusedColumnRng.Column <> 1 Then
Set FirstUnusedColumnRng = FirstUnusedColumnRng(1, 2)
End If
FirstUnusedColumnNum = FirstUnusedColumnRng.Column
End With
Debug.Print "First used range: " & FirstUnusedColumnRng.Address, _
"First unused column number: " & FirstUnusedColumnNum

End Sub



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Guest]

I use:
lastCol = Sheets("Find").Cells(1, Columns.Count).End(xlToLeft).Column
my first row always has data, hence the cells(1 portion, yours may not, this
gets the last column, to paste in the next just put lastCol+1

 

[Guest]

Hi Don

Boy your quick , thanks very much for you reply but it still keeps pasting
into the same coulmn

here is my full code, I may have something wrong in the code
thanks again for your help
Kind regards
Samijleeds

 

[Guest]

Hi All you very helpful guys
thanks for the quick posts and replies but it still keeps pasting over the
same column not sure if it the rest of the code doing it now but here it is
thanks again for all ytour help
kind regards
samijleeds

<code>
Sub yes()

'Dim variables
Dim y As Long
Dim starta As String
Dim tr As Long, tc As Long
Dim sr As Long, sc As Long
Dim s As Worksheet, t As Worksheet
Dim n As Range
Dim strToFind As String
Dim flstc As Range
Dim LastCol As Long



'Setup
Application.ScreenUpdating = False

LastCol = Sheets("Finds").Cells(1, Columns.Count).End(xlToLeft).Column



Set t = Sheets("Finds")
Set s = Sheets("Draws")

strToFind = InputBox("What's The Number to Search for?")

'Get last used row in Target Sheet
t.Select
tr = Range("d65536").End(xlUp).Offset(1, 0).Row
tc = LastCol

'Start in search sheet at C4
s.Select
Range("c65536:j65536").Select

'Get 'yes'
y = Cells.Find(What:=strToFind, After:=Activecell, LookIn:=xlFormulas,
LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
'Save start address for comparison
starta = Activecell.Address

'Label for goto (pseudo loop)
nextyes:

'Get row/col for copy paste
sr = Activecell.Row
sc = Activecell.Column

'Copy Column heading value to target sheet/cell in first column
'Cells(1, sc).Copy Destination:=t.Cells(tr, tc)

'Copy column "A" cell value to target sheet/cell
Cells(sr, 1).Copy Destination:=t.Cells(tr, tc + 1)

'Set destination = plus one row
tr = tr + 1
'Find next yes (til done)
y = Cells.FindNext(After:=Activecell).Activate
If Activecell.Address = starta Then
t.Select
Exit Sub
End If

'pseudo loop
GoTo nextyes


End Sub
<Code/>

 

[Don Guillett]

Not IF you use

+1

 

[Guest]

Hi Don

It still doesnt work, Ive tried putting different numbers at the end to see
it will paste into any column but it still just pastes into the same column

Thanks for your reply

Kind regards
Samijleeds

 

[Don Guillett]

Without going thru all of your code, you may like this idea better which
works from anywhere in the workbook withOUT any selections. It asks you what
to look for>looks for it in column d of the source sheet>finds it and puts
the value in the next available row on the destination sheet.

Sub findandcopy()
Set sc = Sheets("sheet2")
Set ds = Sheets("sheet3")
what = InputBox("Num to find")

With sc
With .Range("d2:d" & .Cells(Rows.Count, "c").End(xlUp).Row)
Set c = .Find(what, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do

dlr = ds.Cells(Rows.Count, "a").End(xlUp).Row + 1
ds.Cells(dlr, 1).Value = c.Value

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End With
End Sub

 

[Guest]

Hi Guys
thanks you for all your help, I have managed to sort this out. My coding was
not allowing the paste columns to be pasted, I had the last know column set
as column D instead of IV once Id changed it it worked, thank you again your
brill
SamijLeeds