Macro limits saving of the data

[osevero]

Hi again,

I need help here too, I have this table: examp.xlsx 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-prog...-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!! 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! Thanks! 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! 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: example_6.xlsm

[osevero]

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

[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!

Cheers