Macro limits saving of the data

[osevero]

Hi again,

I need help here too, I have this table: 10725 and I'm using a macro that saves the data to another spreadsheet with this code:



Sub Save()

Dim i&
With Sheets("Plan1").Range("B6").CurrentRegion
i = .Rows.Count - 1
With .Offset(1).Resize(i)
Union(.Columns(1).Resize(, 10), .Columns(12), .Columns(14).Resize(, 3)).Copy
Sheets("Plan2").Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial xlPasteAllExceptBorders
End With
End With
With Sheets("Plan2").Cells(Rows.Count, 2).End(xlUp)(2).Resize(i)
.FormulaR1C1 = "=ROW(RC[-2])-6"
.Value = .Value
End With
Application.CutCopyMode = False

End Sub


However I want to limit this saving to not save if there is no data in column C6, D6, E6, F6, G6, H6, J6, K6, M6, O6, but can save if there is no data in B6, I6, L6, N6, P6, Q6
So if there is no data in these columns, a warning appears saying "Unable to save. Complete the columns". Does anyone know how to do this?

Are trying to help me on this forum as well: http://www.excelforum.com/excel-programming-vba-macros/961984-macro-limits-saving-of-the-data.html

Cheers!

[mrojas]

Sounds to me like you'll need a Case structure where you would exit the routine if one of the conditions is met, somewhat similar to this:

Select Case Something
Case IsEmpty(Range(C:6, C:200)) = True
MsgBox "Blah, Blah"
Exit sub
Case ... next cell to check D6 and so on. Do not include your cells B6, I6 etc.
End Select
Proceed to save

This assumes you have range of values in column C rows 6 to 200, change as needed

[osevero]

Hmm, more ideas for this problem, anyone?

[osevero]

Some help guys please. I'll need this done...

[Paul_Hossler]

not save if there is no data in column C6, D6, E6, F6, G6, H6, J6, K6, M6, O6, but can save if there is no data in B6, I6, L6, N6, P6, Q6


So to paraphrase the requirements ...

If C6 is blank and D6 is blank and ..... O6 is blank then
Display message

If B6 is blank and I6 is blank and .... Q6 is blank then
save the data

So all 10 of the first group must be blank to get the message

Or all 6 of the second group must be blank to save

Correct?


What if there's data in C6 and in Q6? Then no message and no save?

You only want to copy Row 6, or multiple rows?




Option Explicit
'not save if there is no data in column C6, D6, E6, F6, G6, H6, J6, K6, M6, O6, but can save if there is no data in B6, I6, L6, N6, P6, Q6
Sub CodeFragment()
Dim iSumOfShowMessageCells As Long
Dim iSumOfSaveDataCells As Long
Dim i As Long
For i = 2 To 17
Select Case i
Case 3, 4, 5, 6, 7, 8, 10, 11, 13, 15
If Len(Cells(6, i).Value) = 0 Then iSumOfShowMessageCells = iSumOfShowMessageCells + 1
Case 2, 9, 12, 14, 16, 17
If Len(Cells(6, i).Value) = 0 Then iSumOfSaveDataCells = iSumOfSaveDataCells + 1
End Select
Next i

If iSumOfShowMessageCells <> 10 Then
MsgBox "First group not all blank"
End If
If iSumOfSaveDataCells = 6 Then
MsgBox "Save the data"
End If

End Sub



Not the most efficient way to do it

Paul

[osevero]

First of all, thank you for the feedback! Not exactly what I need... If one of the C6, D6, E6, F6, G6, H6, J6, K6, M6, O6 is blank then the macro no longer proceeds to the code that copies and pastes the data in another spreadsheet (see the code in the initial message) and emits the message: "you should fill more data". If any of the B6, I6, L6, N6, P6, Q6 are empty, there's no problem, and the macro can copy/paste data, and emits the message: "data stored!!".
This part of the code has to complete with the code I wrote in the initial message that makes the data, after passing through this part, are pasted in another spreadsheet.

"You only want to copy Row 6, or multiple rows?"
It's not only in row 7, is in all rows below 6 with data (see the xlsx which is the first post). But if it's difficult to do so, we define that is only to row 7 to the 17.


I'll really appreciate a lot more help,

Cheers!

[Paul_Hossler]

Maybe this?





Sub OurSub()
Dim iCol As Long, iRow As Long
Dim rData As Range, rDestination As Range

Set rData = Sheets("Plan1").Range("B6").CurrentRegion

With rData
For iRow = 2 To .Rows.Count
For iCol = 2 To .Columns.Count
Select Case iCol
Case 2 To 7, 9 To 10, 2, 14
If Len(.Cells(iRow, iCol).Value) = 0 Then
Call MsgBox(.Cells(iRow, iCol).Address & " is blank, no data saved", vbCritical + vbOKOnly, "Save Data")
GoTo NextRow
End If
End Select
Next iCol
Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)
Call .Rows(iRow).Copy(rDestination)

Call rDestination.Cells(1, 13).Delete(xlToLeft)
Call rDestination.Cells(1, 11).Delete(xlToLeft)

NextRow:
Next iRow
End With

Application.CutCopyMode = False
End Sub




Paul

[osevero]

Thank you Paul, that's closer!! :bow: But there are two problems with this code:

First: using this macro is answered for example: "$O$8 is blank, no data saved" and I dont want the macro say what the blank cell, but only said: "We found rows with missing data. These rows weren't saved" or "You should fill more data"


Secound: when I told you that new code have to belong to the initial code of the first message is because the initial code was developed to stored the data and add a number in the ID column in Plan2. So when data is stored, the code sees the last number in the ID column in Plan2 and add +1 for the new rows with data in Plan2 become numbered 1,2,3,4 ... if you have doubts how it works, try to use the code that's in the first message. What I mean is that the new code must stored and add this number in the ID column of Plan2.

Thanks, right now, for the tremendous help!

[Paul_Hossler]

First: using this macro is answered for example: "$O$8 is blank, no data saved" and I don't want the macro say what the blank cell, but only said: "We found rows with missing data. These rows weren't saved" or "You should fill more data"


If ANY of the 'can't be blank' cells in ANY of the rows are empty, you want a message ONE time, but copy the rows with the blanks anyway?




Second: when I told you that new code have to belong to the initial code of the first message is because the initial code was developed to stored the data and add a number in the ID column in Plan2. So when data is stored, the code sees the last number in the ID column in Plan2 and add +1 for the new rows with data in Plan2 become numbered 1,2,3,4 ... if you have doubts how it works, try to use the code that's in the first message. What I mean is that the new code must stored and add this number in the ID column of Plan2.



Easy enough (I think) if I understand



Sub OurSub2()
Dim iCol As Long, iRow As Long, iID As Long
Dim rData As Range, rDestination As Range
Dim bMissingData As Boolean

Set rData = Sheets("Plan1").Range("B6").CurrentRegion

bMissingData = False
iID = 0

With rData
For iRow = 2 To .Rows.Count
For iCol = 2 To .Columns.Count
Select Case iCol
Case 2 To 7, 9 To 10, 2, 14
If Len(.Cells(iRow, iCol).Value) = 0 Then
bMissingData = True
GoTo NextRow
End If
End Select
Next iCol
Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)
Call .Rows(iRow).Copy(rDestination)

Call rDestination.Cells(1, 13).Delete(xlToLeft)
Call rDestination.Cells(1, 11).Delete(xlToLeft)

iID = iID + 1
rDestination.Offset(0, -1).Value = iID
NextRow:
Next iRow
End With

Application.CutCopyMode = False
If bMissingData Then
Call MsgBox( _
"We found rows with missing data. These rows weren't saved" & vbCrLf & vbCrLf & _
"You should fill more data", vbCritical + vbOKOnly, "Save Data")
End If

End Sub




Paul

[osevero]

That's it, but there's a problem: when the first data (or rows) is stored, the numbers in the ID column are correct, but when you save the second time the numbers are not aligned numerically. For example, imagine that I save 4 rows with data and then I save over 5 rows, the numbers of the ID column should be 123456789 but with that code gets 123412345

[Paul_Hossler]

You never mentioned that you wanted to append multiple runs to the bottom of Plan2, so the ID was starting at 1 each time




Sub OurSub3()
Dim iCol As Long, iRow As Long
Dim rData As Range, rDestination As Range
Dim bMissingData As Boolean

Set rData = Sheets("Plan1").Range("B6").CurrentRegion

bMissingData = False

With rData
For iRow = 2 To .Rows.Count
For iCol = 2 To .Columns.Count
Select Case iCol
Case 2 To 7, 9 To 10, 2, 14
If Len(.Cells(iRow, iCol).Value) = 0 Then
bMissingData = True
GoTo NextRow
End If
End Select
Next iCol
Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)
Call .Rows(iRow).Copy(rDestination)

Call rDestination.Cells(1, 13).Delete(xlToLeft)
Call rDestination.Cells(1, 11).Delete(xlToLeft)

If Not IsNumeric(rDestination.Offset(-1, -1).Value) Then
rDestination.Offset(0, -1).Value = 1
Else
rDestination.Offset(0, -1).Value = rDestination.Offset(-1, -1).Value + 1
End If
NextRow:
Next iRow
End With

Application.CutCopyMode = False
If bMissingData Then
Call MsgBox( _
"We found rows with missing data. These rows weren't saved" & vbCrLf & vbCrLf & _
"You should fill more data", vbCritical + vbOKOnly, "Save Data")
End If

End Sub



Easily included

Paul

[osevero]

You're the man! :bow: Thanks! :clap: Sorry I hadn't mentioned because I thought that it was possible to adapt my code of first message (which adjusts the numbers of the ID column) to this new code.


One more thing, imagine that I want to limit the operation of this new code, if exists cells in the column R with the word "electric" the macro sends a message: "We found a electric, are you sure you wish to continue?" If yes, the macro reads the rest of the code to save data, if not, the macro doesn't read the rest of the code. Can you do this?

[Paul_Hossler]

Sure ... I think this is what you wanted




Option Explicit
Sub OurSub4()
Const csModule As String = "Save Data"

Dim iCol As Long, iRow As Long
Dim rData As Range, rDestination As Range
Dim bMissingData As Boolean

Set rData = Sheets("Plan1").Range("B6").CurrentRegion

bMissingData = False

With rData
For iRow = 2 To .Rows.Count
For iCol = 2 To .Columns.Count
Select Case iCol
Case 2 To 7, 9 To 10, 2, 14
If Len(.Cells(iRow, iCol).Value) = 0 Then
bMissingData = True
GoTo NextRow
End If
End Select
Next iCol

If .Cells(iRow, .Columns.Count).Value Like "electric" Then
If MsgBox("We found a electric, are you sure you wish to continue?", vbQuestion + vbYesNo, csModule) = vbNo Then
GoTo NextRow
End If
End If

Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)
Call .Rows(iRow).Copy(rDestination)

Call rDestination.Cells(1, 13).Delete(xlToLeft)
Call rDestination.Cells(1, 11).Delete(xlToLeft)

If Not IsNumeric(rDestination.Offset(-1, -1).Value) Then
rDestination.Offset(0, -1).Value = 1
Else
rDestination.Offset(0, -1).Value = rDestination.Offset(-1, -1).Value + 1
End If
NextRow:
Next iRow
End With

Application.CutCopyMode = False
If bMissingData Then
Call MsgBox( _
"We found rows with missing data. These rows weren't saved" & vbCrLf & vbCrLf & _
"You should fill more data", vbCritical + vbOKOnly, csModule)
End If
End Sub



Paul

[osevero]

Paul, thank you again! The code is getting perfect but I need some adjustments:

1) The data in column R shouldn't be copied and pasted into Plan2;
2) The data which are copied/pasted, only shoud be numbers and letters that are inside the cell, and shouldn't be copied/pasted the format and color of the cell;
3) If the data is saved, then appears a message saying the data was saved successfully.

Paul, as soon as you can, help me please. Cheers!

[osevero]

.

[Paul_Hossler]

Try this



Option Explicit
Sub OurSub5()
Const csModule As String = "Save Data"

Dim iCol As Long, iRow As Long
Dim rData As Range, rDestination As Range
Dim bMissingData As Boolean

Set rData = Sheets("Plan1").Range("B6").CurrentRegion
Sheets("Plan2").Select

bMissingData = False

With rData
For iRow = 2 To .Rows.Count
For iCol = 2 To .Columns.Count
Select Case iCol
Case 2 To 7, 9 To 10, 2, 14
If Len(.Cells(iRow, iCol).Value) = 0 Then
bMissingData = True
GoTo NextRow
End If
End Select
Next iCol

If .Cells(iRow, .Columns.Count).Value Like "electric" Then
If MsgBox("We found a electric, are you sure you wish to continue?", vbQuestion + vbYesNo, csModule) = vbNo Then
GoTo NextRow
End If
End If

Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)

Call .Cells(iRow, 1).Resize(1, 16).Copy

rDestination.Select

Selection.Parent.PasteSpecial (xlPasteFormulasAndNumberFormats)


Call rDestination.Cells(1, 13).Delete(xlToLeft)
Call rDestination.Cells(1, 11).Delete(xlToLeft)

If Not IsNumeric(rDestination.Offset(-1, -1).Value) Then
rDestination.Offset(0, -1).Value = 1
Else
rDestination.Offset(0, -1).Value = rDestination.Offset(-1, -1).Value + 1
End If
NextRow:
Next iRow
End With

Application.CutCopyMode = False
If bMissingData Then
Call MsgBox( _
"We found rows with missing data. These rows weren't saved" & vbCrLf & vbCrLf & _
"You should fill more data", vbCritical + vbOKOnly, csModule)
Else
Call MsgBox("All Data was saved successfully", vbInformation + vbOKOnly, csModule)
End If
End Sub

[osevero]

Works very well! :bow: Thanks! Sorry but if the column R (data whether it's electric or not) were in the place of the column L how it would look the code? See the change I made in the column here: 10810

[osevero]

Paul, do you know how to do what I explained in the previous post? : pray2:: pray2:: pray2:

[Paul_Hossler]

Yes



Option Explicit
Sub OurSub6()
Const csModule As String = "Save Data"

Dim iCol As Long, iRow As Long
Dim rData As Range, rDestination As Range
Dim bMissingData As Boolean

Set rData = Sheets("Plan1").Range("B6").CurrentRegion
Set rData = rData.Cells(1, 1).Resize(rData.Rows.Count, 17)
Sheets("Plan2").Select

bMissingData = False

Application.ScreenUpdating = False

With rData
For iRow = 2 To .Rows.Count
For iCol = 2 To .Columns.Count
Select Case iCol
Case 2 To 7, 9 To 10, 13, 15
If Len(.Cells(iRow, iCol).Value) = 0 Then
bMissingData = True
GoTo NextRow
End If
End Select
Next iCol

If .Cells(iRow, 11).Value Like "electric" Then
If MsgBox("We found a electric, are you sure you wish to continue?", vbQuestion + vbYesNo, csModule) = vbNo Then
GoTo NextRow
End If
End If

Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)

Call .Cells(iRow, 1).Resize(1, 17).Copy

rDestination.Select

Selection.Parent.PasteSpecial (xlPasteFormulasAndNumberFormats)


Call rDestination.Cells(1, 12).Delete(xlToLeft)
Call rDestination.Cells(1, 11).Delete(xlToLeft)

If Not IsNumeric(rDestination.Offset(-1, -1).Value) Then
rDestination.Offset(0, -1).Value = 1
Else
rDestination.Offset(0, -1).Value = rDestination.Offset(-1, -1).Value + 1
End If
NextRow:
Next iRow
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
If bMissingData Then
Call MsgBox( _
"We found rows with missing data. These rows weren't saved" & vbCrLf & vbCrLf & _
"You should fill more data", vbCritical + vbOKOnly, csModule)
Else
Call MsgBox("All Data was saved successfully", vbInformation + vbOKOnly, csModule)
End If

End Sub



Paul

[osevero]

Thanks a lot Paul, your work in this code was fantastic! :bow:

Cheers

[osevero]

Sorry Paul, I need your help for one last : pray2:

I need instead of data starts to be pasted in the row 7 of Plan2, I need to start in row 8 (the columns stand in row 6, that's in the same position. The row 7 becomes empty). Is it possible do that?

[Paul_Hossler]

Just add the marked line after the statement above



Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)
If rDestination.Row = 7 Then Set rDestination = rDestination.Offset(1, 0) ' <<<< Add this


Paul

[osevero]

:bow: Freakin' awesome! Thanks a lot for your help!

[osevero]

Paul, I need one modification in the code please:

-The copy/paste is only the result (number or letter) that is in the cell. Not with formulas. This is because the code copies the formulas that are inside cells and I don't want it.

Can you do this?

Cheers!

[Paul_Hossler]

Change

Selection.Parent.PasteSpecial (xlPasteFormulasAndNumberFormats)

to

Selection.Parent.PasteSpecial (xlPasteValuesAndNumberFormats)





Paul

[osevero]

That's right Paul thanks! :)

Sorry I have another problem Paul:

-When the code is reading the rows to know which rows have data and then copy that data, the code detects the rows that have formulas or errors and then answers the MsgBox (We found rows with missing data...) and that's wrong. I just want the code to read rows with values and letters (which will be written by the user in column C, D, E, F, G, H, J, K, M, O). So the code should only "answer" if the rows have values ​​or letters.

I use the function = IFERROR but even so the code reads these rows, which is due to the formulas that are within the cells.

I appreciate your help,

Cheers

[Paul_Hossler]

Not sure I understand

So try this one

If there is a Formula in any of the cells, then that row is not copied and there is no message caused by that row

Paul

[osevero]

I think you didnt understand... Paul for you understand better the problem, I made changes in the Excel here: 10849

In this .xlsm I added a Sheet3 (because some cells of Sheet1 will seek the data in the Sheet3). In Sheet1, I use cells with data validation (in column C) and VLOOKUP functions (in column H and J) as you can observe.

What I need is the code just copy/paste the rows with data of columns obligatory (MsgBox: Data saved successfully), if there are no data in the columns obligatory, the code does nothing. From now, just columns H and J are obligatory. If there is numbers (not errors) in the cells in column H and J then the code can copy/paste this row and send the message "Data saved successfully".

Can you fix the code to work this way?

Thanks Paul for all your help so far

[Paul_Hossler]

Option Explicit
Sub Sub_10()
Const csModule As String = "Save Data"

Dim iCol As Long, iRow As Long
Dim rData As Range, rDestination As Range
Dim bMissingData As Boolean

Set rData = Sheets("Plan1").Range("B6").CurrentRegion
Set rData = rData.Cells(1, 1).Resize(rData.Rows.Count, 17)
Sheets("Plan2").Select

bMissingData = False

Application.ScreenUpdating = False

With rData
For iRow = 2 To .Rows.Count
If Len(.Cells(iRow, 7).Value) = 0 Or Len(.Cells(iRow, 9).Value) = 0 Then
bMissingData = True
GoTo NextRow
End If

If .Cells(iRow, 11).Value Like "electric" Then
If MsgBox("We found a electric, are you sure you wish to continue?", vbQuestion + vbYesNo, csModule) = vbNo Then
GoTo NextRow
End If
End If

Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)
If rDestination.Row = 7 Then Set rDestination = rDestination.Offset(1, 0)

Call .Cells(iRow, 1).Resize(1, 17).Copy

rDestination.Select

Selection.Parent.PasteSpecial (xlPasteValuesAndNumberFormats)

Call rDestination.Cells(1, 12).Delete(xlToLeft)
Call rDestination.Cells(1, 11).Delete(xlToLeft)

If Not IsNumeric(rDestination.Offset(-1, -1).Value) Then
rDestination.Offset(0, -1).Value = 1
Else
rDestination.Offset(0, -1).Value = rDestination.Offset(-1, -1).Value + 1
End If
NextRow:
Next iRow
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
If Not bMissingData Then
Call MsgBox("All Data was saved successfully", vbInformation + vbOKOnly, csModule)
End If

End Sub



Paul

[osevero]

Thanks Paul :bow: the code is working fine for what I need but the message "Data was saved sucessfully" doesnt appear when data are saved. Do you know why?

[Paul_Hossler]

if there is missing data in H or J in any of the rows, the Data Saved message will not display

if you want it to display if ANY data is saved



Option Explicit
Sub Sub_11()
Const csModule As String = "Save Data"

Dim iCol As Long, iRow As Long
Dim rData As Range, rDestination As Range
Dim bDataSaved As Boolean

Set rData = Sheets("Plan1").Range("B6").CurrentRegion
Set rData = rData.Cells(1, 1).Resize(rData.Rows.Count, 17)
Sheets("Plan2").Select

bDataSaved = False

Application.ScreenUpdating = False

With rData
For iRow = 2 To .Rows.Count
If Len(.Cells(iRow, 7).Value) = 0 Or Len(.Cells(iRow, 9).Value) = 0 Then GoTo NextRow

If .Cells(iRow, 11).Value Like "electric" Then
If MsgBox("We found a electric, are you sure you wish to continue?", vbQuestion + vbYesNo, csModule) = vbNo Then
GoTo NextRow
End If
End If

Set rDestination = Sheets("Plan2").Cells(Sheets("Plan2").Rows.Count, 6).End(xlUp).Offset(1, -3)
If rDestination.Row = 7 Then Set rDestination = rDestination.Offset(1, 0)
bDataSaved = True

Call .Cells(iRow, 1).Resize(1, 17).Copy

rDestination.Select

Selection.Parent.PasteSpecial (xlPasteValuesAndNumberFormats)

Call rDestination.Cells(1, 12).Delete(xlToLeft)
Call rDestination.Cells(1, 11).Delete(xlToLeft)

If Not IsNumeric(rDestination.Offset(-1, -1).Value) Then
rDestination.Offset(0, -1).Value = 1
Else
rDestination.Offset(0, -1).Value = rDestination.Offset(-1, -1).Value + 1
End If
NextRow:
Next iRow
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
If bDataSaved Then
Call MsgBox("All Data was saved successfully", vbInformation + vbOKOnly, csModule)
End If

End Sub




Paul