Assistance with Creating a Specific Macro using VBA code

As requested I attached an example workbook.

The first tab contains the input data and the second tab shows what the output TXT file should contain.

Hi

See how this goes.

Sub aaa()
  filestr = "Test_" & Format(Now(), "yyyy_mm_dd_hh_mm_ss") & "_Full.txt"
  Open "c:\test\" & filestr For Output As #1
  lastcol = Cells(6, Columns.Count).End(xlToLeft).Column
  lastrow = Cells(Rows.Count, 1).End(xlUp).Row
  
  For i = 2 To lastcol
    If Cells(6, i) = "X" Then
      For j = 8 To lastrow
        If UCase(Left(Cells(j, 1).Value, 3)) <> "JOB" And UCase(Left(Cells(j, 1).Value, 3)) <> "USER" And Not IsEmpty(Cells(j, i)) Then
          Print #1, Cells(j, 1).Value & Cells(j, i).Value
        End If
      Next j
    End If
  Next i
  
  Close #1
End Sub

rylo

Originally Posted by rylo

Hi

See how this goes.

rylo

Morning Rylo,

First of all MANY thanks. It works almost perfect on the first go.
I must say I am VERY impressed with the results !!!



The result I got was a TXT file with the correct filename in the correct folder with the following contents

EmployeeId:10000001
EmployeeNumber:10000001
Id:10000001-22210000-30000001
FunctionId:30000001
FunctionDescription:Software Tester
OrganisationUnitId:22210000
Primary:true
ObjectType:Job
BeginDate:1-12-2008
DisplayName:Dhr. TU1 TeSt User1
Id:10000001
Initials:TU1
Firstname:Test1
MicrosectionNumber:123456
MiddleName:TeSt
MiddleNameSpouse:MidSpou1
NameFormatType:1
Surname:User1
SurnameSpouse:SurSpou1
Title:Dhr.
Type:1
ObjectType:User
EmployeeId:10000002
EmployeeNumber:10000002
Id:10000002-21111300-30000002
FunctionId:30000002
FunctionDescription:WC Juffrouw
OrganisationUnitId:21111300
Primary:true
ObjectType:Job
BeginDate:1-12-2008
DisplayName:Mevr. TU2 tteesstt SurSpou2 User2
Id:10000002
Initials:TU2
Firstname:Test2
MicrosectionNumber:654321
MiddleName:tteesstt
MiddleNameSpouse:MidSpou2
NameFormatType:2
Surname:User2
SurnameSpouse:SurSpou2
Title:Mevr.
Type:1
ObjectType:User


What is missing here is:
An additional blanc line (enter, carriage return or whatever you want to call it) after each "ObjectType:User" or "ObjectType:Job".

Other then that, it works absolutely flawless !!!

I don't know if you ever happen to come to the south of the Netherlands, but if you do send me an email and I'll happily treat you to a few beers

Hi

Here goes.

Sub aaa()
  filestr = "Test_" & Format(Now(), "yyyy_mm_dd_hh_mm_ss") & "_Full.txt"
  Open "c:\test\" & filestr For Output As #1
  lastcol = Cells(6, Columns.Count).End(xlToLeft).Column
  lastrow = Cells(Rows.Count, 1).End(xlUp).Row
  
  For i = 2 To lastcol
    If Cells(6, i) = "X" Then
      For j = 8 To lastrow
        If UCase(Left(Cells(j, 1).Value, 3)) <> "JOB" And UCase(Left(Cells(j, 1).Value, 3)) <> "USER" And Not IsEmpty(Cells(j, i)) Then
          Print #1, Cells(j, 1).Value & Cells(j, i).Value
          If UCase(Cells(j, 1).Value) = "OBJECTTYPE:" Then Print #1, ""
        End If
      Next j
    End If
  Next i
  
  Close #1
End Sub

rylo

Originally Posted by rylo

Hi

Here goes.

rylo

Absolutely perfect

Many, MANY thanks mate!