Gather Data from one column based on another column value and export data to notepad

[Marclem]

Hi Everyone!

I found below code online and would like to tweak it to do the following:

Column A has multiple equal values and column B have different values
[ul][li]I would like to have a code that will see the data on column A (which has multiple equal value)[/li][/ul]
[ul][li]Find the range of equal value then create a notepad file with the name of the value found on column A (for example column A row 1-10 have same value name = AACE001N, then notepad file name will be AACE001N)[/li][/ul]
[ul][li]Then copy data range (which belongs to all rows related to column A AACE001N) from column B into the created Notepad file that was created and named AACE001N[/li][/ul]
[ul][li]Then proceed finding more new value from column A and continue creating notepad files and copying the data from column B which corresponds to value from column A[/li][/ul]

I Am attaching the file

Below the code I have now but what it does now is to created column A and B header name as a notepad files and copy data into the notepad:

Sub ExportToNotepad()
Dim wsData As Variant
Dim myFileName As String
Dim FN As Integer
Dim p As Integer, q As Integer
Dim path As String
Dim myString As String
Dim lastrow As Long, lastcolumn As Long

lastrow = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
path = "C:\AWARDS\Notepad\"

For p = 1 To lastcolumn
wsData = ActiveSheet.Cells(1, p).Value
If wsData = "" Then Exit Sub
myFileName = wsData
myFileName = myFileName & ".txt"
myFileName = path & myFileName
'MsgBox myFileName
For q = 2 To lastrow
myString = myString & vbCrLf & Cells(q, p)

FN = FreeFile
Open myFileName For Output As #FN
Print #FN, myString
Close #FN
Next q
myString = ""
Next p

End Sub

 

[Andrzejek]

I create this sample data in Excel:

[pre]
AwardNo Name
AAA VFD
AAA DSA
AAA DFG
BBB DFSDF
BBB SCVS
BBB SDFBVC
CCC GHJGHJN
CCC CVBV
CCC HJFGFV
[/pre]
And this code:

Option Explicit

Sub ExportToNotepad()
Dim R As Integer
Dim strColAVal As String
Dim strOutput As String

R = 2

Do While Range("A" & R).Value <> ""
    strColAVal = Range("A" & R).Value

    Do While strColAVal = Range("A" & R).Value
        strOutput = strOutput & Range("B" & R).Value & vbNewLine
        R = R + 1
    Loop
    
    If strOutput <> "" Then
        Call SaveFile(strColAVal, strOutput)
        strOutput = ""
    End If
Loop

End Sub

Sub SaveFile(ByRef strName As String, ByRef strText As String)
Dim FN As Integer

FN = FreeFile
Open "[red]C:\TEMP\[/red]" & strName & ".txt" For Output As #FN
Print #FN, strText
Close #FN

End Sub

creates three files in [tt]C:\TEMP\[/tt]
AAA.txt
BBB.txt
CCC.txt


---- Andy

There is a great need for a sarcasm font.

 

[Marclem]

Thank you Andy for your code, it's working exactly how I need it to but I got an error saying type mismatch error code 13 on line:

strOutput = strOutput & Range("B" & R).Value & vbNewLine


I am attaching my file please note it has about 14328 rows and it shows it stopped creating the notepad files after row number 5007 which was AWard number EXXON003TZ.


Thank you,

 

[Andrzejek]

Since you have whole bunch of links in Column B and you want to end up with just text in the text files, you may try to Copy the links and Paste as Values only. Who knows what's in them...?

type mismatch error - it is possible that this line of code tries to cram something from Column B that is not allowed in e String variable.


---- Andy

There is a great need for a sarcasm font.

 

[Marclem]

Hi Andy,

I found a #NAME expression on column B and once I fix that your code ran fine! Thank you so much!

The only final step I have and if you can assist is this:

I need to add the below code text into a cell:

Get-Content .\&A2&.txt | Foreach-Object { copy-item -Path $_ -Destination "C:\AWARDS\&A2&\"}

My final final text needs to show in the cell like this:
Get-Content .\AACE001N.txt | Foreach-Object { copy-item -Path $_ -Destination "C:\AWARDS\AACE001N\"}

I tried adding like this and got error:
= "Get-Content .\"&A2&".txt | Foreach-Object { copy-item -Path $_ -Destination "C:\AWARDS\"&A2&"\"}


Thank you,

 

[Andrzejek]

This code:

Option Explicit

Sub AddThisText()

Cells(5, 5).Value = "Get-Content .\AACE001N.txt | Foreach-Object { copy-item -Path $_ -Destination [blue]" & Chr(34) & "[/blue]C:\AWARDS\AACE001N\[blue]" & Chr(34) & "[/blue]}"

End Sub

Will give you this:

---- Andy

There is a great need for a sarcasm font.

 

[Marclem]

Thank you Andy for all your support! Really appreciate it!

 

[Marclem]

Hi Everyone,

The code provided by Andy is working fine the only problem I am having is that the output txt file is having a double blank space after the last data which when I run a power shell command it does not like having blank spaces inside the txt files,

Code:

Sub ExportToNotepad()
Dim R As Integer
Dim strColAVal As String
Dim strOutput As String

R = 2

Do While Range("A" & R).Value <> ""
strColAVal = Range("A" & R).Value

Do While strColAVal = Range("A" & R).Value
strOutput = strOutput & Range("B" & R).Value & vbNewLine
R = R + 1
Loop

If strOutput <> "" Then
Call SaveFile(strColAVal, strOutput)
strOutput = ""
End If
Loop

End Sub

Sub SaveFile(ByRef strName As String, ByRef strText As String)
Dim FN As Integer

FN = FreeFile
Open "C:\AWARDS\_Narrative Reports\" & strName & ".txt" For Output As #FN
Print #FN, strText
Close #FN

End Sub



For example: inside txt file created by the code above shows 2 blank spaces after the last data line, I need to make sure there are no extra blank spaces at the end of the data inside the txt file:

Notepad txt file:

ABBOT003N TNS Haiti Peanut Program Budget_2014 Abbott_v1.3RJ (1).xlsx
blank space 1
blank space 2

Thank you

 

[Andrzejek]

First, it is time to format your code as CODE:

Always use Preview before Submit Post.

Second,
I can see one extra line added by [tt]vbNewline[/tt], you can eliminate it by:

Do While strColAVal = Range("A" & R).Value[blue]
    If Len(strOutput) = 0 Then
        strOutput = Range("B" & R).Value
    Else
        strOutput = strOutput & vbNewLine & Range("B" & R).Value
    End If[/blue]
    R = R + 1
Loop

The other empty line may come from:

[pre]
AwardNo Name
AAA VFD
AAA [blue]<empty>[/blue]
AAA [blue]<empty>[/blue]
BBB DFSDF[/pre]

---- Andy

There is a great need for a sarcasm font.

 

[Marclem]

Hi Andy,

Apologies for not replying earlier, just wanted to say thank you for your support!