Copying set of cells with a condition
On 28 jul, 20:35, wrote:
Hello Group,
I am getting cell reference error when I try to do the following. This
is what I have:
I have an excel sheet with bunch of data. All I am trying to do is to
select the set of cells that have the same B range value and paste it
into a new workbook and save it as a *.txt file.
For example,
B2 to B102 has the same value 101.23; cells C2 to Z102 have different
values
B103 to B176 has the same value 255478.32; cells C103 to Z176 have
different values
B177 to B250 has the same value 2412.56; cells C177 to Z250 have
different values
.....
B40213 - B40315 has 122453.2; cells C40213 to Z40315 have different
values
I am trying to
Copy vaules B2 to Z102, paste it in a new workbook and save it as a
B2value.txt file.
Copy vaules B103 to Z176, paste it in a new workbook and save it as a
B103value.txt file.
.....
Copy vaules B40213 to Z40315 , paste it in a new workbook and save it
as a B40213.txt file.
I have the macro to paste the selected data into a new workbook and
save it as a txt file but I am getting errors when I try to copy the
set of cells that have the same value in cell B.
Please let me know the macro condition required to accomplish this.
I am going to keep on tweaking my existing code but I would really
appreciate any help.
Thanks!
Kevin
Hi Kevin,
I have cooked this macro in excel 2003:
' ---------- START
Private Const constLastColumn As Integer = 26
Private Const constSeparator As String = "|"
Public Sub SplitOnValueOfColumnB()
Dim lngCurrentRow As Long
Dim lngValueOfColumnB As Long
Dim rngSingleValue As Range
Dim intFreeFile As Integer
Dim strSaveAsFolder As String
Dim strSaveAsFile As String
Dim intLastSlash As Integer
Dim strPrintLine As String
strSaveAsFolder = Application.GetSaveAsFilename( _
InitialFileName:="B2Value.txt", _
FileFilter:="Text (*.txt),*.txt", _
Title:="Select folder for first file")
If strSaveAsFolder < "False" Then
intLastSlash = InStrRev(strSaveAsFolder, "\")
strSaveAsFolder = Left(strSaveAsFolder, intLastSlash)
lngCurrentRow = 2
Do While Not IsEmpty(Cells(lngCurrentRow, 2))
lngValueOfColumnB = Cells(lngCurrentRow, 2)
intFreeFile = FreeFile
strSaveAsFile = strSaveAsFolder & "B" & _
CStr(lngCurrentRow) & "value.txt"
Open strSaveAsFile For Output As intFreeFile
Do While lngValueOfColumnB = Cells(lngCurrentRow, 2)
strPrintLine = ""
For Each rngSingleValue In _
Range(Cells(lngCurrentRow, 2), _
Cells(lngCurrentRow, constLastColumn))
strPrintLine = strPrintLine & _
CStr(rngSingleValue.Value) & _
constSeparator
Next
Print #intFreeFile, strPrintLine
lngCurrentRow = lngCurrentRow + 1
Loop
Close intFreeFile
Loop
Cells(1, 1).Select
End If
End Sub
' ---------- END OF FILE
HTH
Wouter
|