Excel need macro help 1

[GingerR]

hi guys--i'm an Access programmer, but some of the guys i support wanted me to put a bunch of their excel stuff into Access for them. I need to re-format their spreadsheets to go into Access properly. it's been 5+ years since i've worked in Excel and can't quickly remember how to do what i want.

their set up: list of 'wires' in column D, from D286.
list of 'areas' in row2, F2:BX2

then where each row/col meet, they have either blank or an X in the middle, designating where each wire goes thru an 'area'. i can handle everything else if someone can just quickly tell me how to do this:

loop thru each 'wire', and each 'area'. if there's an X, put on a diff worksheet a list of 'wires' and associated 'areas.' if blank, just move on.

wire area
34533T BB9008
34533T BB9009
34533T BB9011

doesnt have to be fancy as i will just copy and paste this into Access. don't need headings, just the list. they have 5 spreadsheets with tons of data, and i'd like to not have to have someone type it all into access. i can figure out how to change ranges etc and make it work on other spreadsheets if i can just get the basic code for my little hack-job. thanks a ton.

 

[VBAjedi]

I think this should work. Just select the whole data range (no column/row headers) and name it "DataRange" in the names box at the top left of the Excel window. (or you could hardcode the range into the code where it refers to "DataRange".

Then put the following code in a module:

Sub MakeList()

Dim Sht1 As Worksheet, Sht2 As Worksheet
Dim C As Range, D As Range, DataRow As Range
Dim AreaRow As Integer, Counter As Integer

Counter = 0
AreaRow = 2

Set Sht1 = Worksheets("Sheet1")
Set Sht2 = Worksheets.Add
For Each C In Sht1.Range("D2:D86")
   Set DataRow = Intersect(Sht1.Range("DataRange"), Sht1.Rows(C.Row & ":" & C.Row))
   If Not DataRow Is Nothing Then
      For Each D In DataRow
         If Len(D.Value) > 0 Then
            Counter = Counter + 1
            Sht2.Range("A" & Counter).Value = C.Value
            Sht2.Range("B" & Counter).Value = Sht1.Cells(AreaRow, D.Column).Value
         End If
      Next D
   End If
Next C
End Sub

Let me know if that works for you!


VBAjedi

 

[Loomah]

Just checked before posting to see if anyone else had replied and.......

However though this will give the relevant results it uses a slightly different method which doesn't need to iterate all cells in the range. The time diff would be virtually none existant in this case though!

Sub b()
Dim c As Range
Dim fc As String
Dim lRow As Long
lRow = 1
With Worksheets(1).Range("Table")
    Set c = .Find(what:="X", LookAT:=xlWhole)
    If Not c Is Nothing Then
        fc = c.Address
        Do
            With Worksheets("sheet2")
                .Cells(lRow, 1) = Worksheets("Sheet1").Cells(c.Row, 4)
                .Cells(lRow, 2) = Worksheets("Sheet1").Cells(1, c.Column)
            End With
            lRow = lRow + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> fc
    End If
End With
End Sub

As with Jedi's code I have referred to a named range ("Table&quot same thing applies here as he has already suggested.

I did it so I posted it!!
Happy Friday
;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[VBAjedi]

Loomah,

As usual - your code is a bit shorter, cleaner, and faster! The only advantage mine has is that it will recognize any kind of marker character in the field - which may not matter in this case.

But I DID highlight mine that cool blue color AND get it posted first!

;^D

VBAjedi

 

[Loomah]

Jedi, my man
There should be an award system for posts that bring a smile. You'd certainly get one from me here!!

One thing though "...AND get it posted first!"
Are you xlbo in disguise - that's his trick!!

Enjoy your weekend (whenever it begins)
I'm off out now but weekends are meaningless in the land of the unemployed (unemployable?)

;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[VBAjedi]

I wouldn't mind being xlbo in disguise ('cause he's SHARP and gets more stars!), but no. . . I am but the lowly 'padewan' JEDI who has learned much from Master xlbo-da. Finish my apprenticeship first, I must. . .

;^)



VBAjedi

 

[GingerR]

thanks guys. i used jedi's only cause it was first. tweaked it a little (had to change to if D.value = "X" cause first your result had more results than the number of x's i counted with countif, looking thru data i see they must have spaces or something else mysterious and invisible that's len>0 in some of the cells and those were coming out in your results) ...anyhow, essentially it worked great. thanks a ton for helping out even tho i didnt have anything started on my own )

ever need any Access stuff, lemme know...

g