Export large table in 2 column format?? 1

[DugsDMan]

I have an Excel spreadsheet (703 rows x 263 columns) with program names for the columns and layout names for the rows. Whenever a certain program reads a particular layout, there is an "X" is the cell where they meet. What I would like to do is create a 2-column text file that contains each program with each layout it reads.

Ex:
Let's say program A reads Layouts 3, 7, and 9
In the spreadsheet, there would be an X in A3, A7, and A9.

What I would like is a text file that looks like:
A 3
A 7
A 9

I want to repeat this for each program in the sheet.

The reason for doing this is so I can import the info to a Db and find the info I need using SQL. There are currently 3 spreadsheets used in my process (Layouts-Programs, Programs-Groups, Groups-People). So, when a layout changes, I have to consult 3 spreadsheets to figure out who needs to be notified. Why they originally did it this way???? I have NO idea.

Any ideas is greatly appreciated.

Thanks,
Doug

 

[PHV]

As a starting point you may consider something like this:
If Cells(i, j).Value = "X" Then
? Replace(Cells(i, j).Address(True, False), "$", " &quot
End If

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[VBAjedi]

Gimme a minute - I'm cooking up some code. . .

VBAjedi

 

[VBAjedi]

Have a play with this. Select your data range (not including column headers or row headers) and name it "DataRange". Select the row containing your Column headers (Program names) and name it "ProgNames". Then select the column containing your row Headers and name it "LayoutNames".

Then replace "Sheet1" and "Sheet2" in the following code with your own Source/destination (respectively) worksheet names, and run it:

Sub MakeSheet()

Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim DRange As Range, ProgRange As Range, LayoutRange As Range
Dim C As Range

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
Set DRange = Sh1.Range("DataArea")
Set ProgRange = Sh1.Range("ProgNames")
Set LayoutRange = Sh1.Range("LayoutNames")
x = 1

For Each C In DRange
   If Len(C.Value) > 0 Then
      Sh2.Range("A" & x).Value = Intersect(C.EntireColumn, ProgRange).Value
      Sh2.Range("B" & x).Value = Intersect(C.EntireRow, LayoutRange).Value
      x = x + 1
   End If
Next C

End Sub

Let me know if that does the trick for you! I'll check the thread again on Monday.

VBAjedi

 

[DugsDMan]

That seems to have done the trick!!!

Thanks for the help!!