Here is the solution, if anyone would benefit from this:
-----------------------------------------------------------------------
Sub Delete_Empty()
Application.ScreenUpdating = False
Dim a As Range
Dim SrchRnga
Set SrchRnga = ActiveSheet.Range("D1",
ActiveSheet.Range("D1000000").End(xlUp))
Do
Set a = SrchRnga.Find("0", LookIn:=xlValues)
If Not a Is Nothing Then a.EntireRow.Delete
Loop While Not a Is Nothing
End Sub
----------------------------------------------------------------------
regards
seba
On 2 feb., 19:40, Seba <sebastjan.hri...@gmail.com> wrote:
> Hi,
>
> I need further assistance on this matter.
> After I create a database, how can I delete entire rows where cell in
> column C (C2, C3,....) equals 0?
>
> thank you in advance,
> seba
>
> On 28 jan., 15:33, ashish koul <koul.ash...@gmail.com> wrote:
>
> > alright let us know if you require any help
>
> > On Fri, Jan 28, 2011 at 2:51 PM, Seba <sebastjan.hri...@gmail.com> wrote:
> > > Hi,
>
> > > I made the following adjustment (marked with stars). It works fine. Do
> > > you see any error in code or possible improvements? I will make an
> > > addtional macro for: removing double entries + deleting rows with
> > > value=0 + sorting
>
> > > My modification:
>
> > > ----------------------------------------------
> > > Sub consolidatefromdifferentworkbooks()
>
> > > Application.DisplayAlerts = False
> > > 'On Error GoTo abc
> > > Dim ask As Workbook
> > > Dim ask2 As Workbook
> > > Dim ASK3 As Workbook
> > > Set ASK3 = ActiveWorkbook
> > > Dim i As Long
> > > Dim j As Long
> > > Dim N, z, r, s, k As Long
> > > s = 1
> > > k = 1
> > > Dim x As String
> > > Dim temp As String
>
> > > Sheets(1).Select
> > > Range("A65356").Select
> > > Selection.End(xlUp).Select
> > > r = ActiveCell.Row
>
> > > Workbooks.Open Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
> > > Set ask = ActiveWorkbook
> > > For i = 2 To r
>
> > > 'Workbooks(Range("a" & i).Value).Windows(1).Visible = False
>
> > > ASK3.Activate
> > > Sheets(1).Select
> > > Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
> > > Set ask2 = ActiveWorkbook
> > > Sheets(1).Select
>
> > > Range("A1").Select
>
> > > ActiveCell.SpecialCells(xlLastCell).Select
>
> > > N = ActiveCell.Row
> > > If N >= 2 Then
>
> > > Rows("1:" & N).Select
>
> > > Selection.Copy
>
> > > 'Sheets.Add After:=Sheets(Sheets.Count)
> > > ask.Activate
> > > ask.Sheets(1).Activate
> > > Sheets(1).Select
> > > Range("A1").Select
> > > ActiveCell.SpecialCells(xlLastCell).Select
>
> > > *****************************z = ActiveCell.Row +
> > > 1*****************************************
>
> > > Range("A" & z).Select
> > > ***************************************Selection.PasteSpecial
> > > Paste:=xlPasteValues**************************************
> > > ActiveWorkbook.Save
> > > ask2.Activate
> > > ask2.Close
> > > End If
>
> > > Next i
>
> > > 'abc:
> > > 'Exit Sub
> > > Application.DisplayAlerts = True
> > > End Sub
> > > ----------------------------------------------------------
>
> > > regards
> > > seba
>
> > > On 27 jan., 17:31, ashish koul <koul.ash...@gmail.com> wrote:
> > > > Sub consolidatefromdifferentworkbooks()
>
> > > > Application.DisplayAlerts = False
> > > > 'On Error GoTo abc
> > > > Dim ask As Workbook
> > > > Dim ask2 As Workbook
> > > > Dim ASK3 As Workbook
> > > > Set ASK3 = ActiveWorkbook
> > > > Dim i As Long
> > > > Dim j As Long
> > > > Dim N, z, r, s, k As Long
> > > > s = 1
> > > > k = 1
> > > > Dim x As String
> > > > Dim temp As String
>
> > > > Sheets(1).Select
> > > > Range("A65356").Select
> > > > Selection.End(xlUp).Select
> > > > r = ActiveCell.Row
>
> > > > Workbooks.Open Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
> > > > Set ask = ActiveWorkbook
> > > > For i = 2 To r
>
> > > > 'Workbooks(Range("a" & i).Value).Windows(1).Visible = False
>
> > > > ASK3.Activate
> > > > Sheets(1).Select
> > > > Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
> > > > Set ask2 = ActiveWorkbook
> > > > * 'chnage sheet name here*
> > > > *Sheets("PRIPRAVA_PROJEKTA").Select
> > > > *
> > > > Range("A1").Select
>
> > > > ActiveCell.SpecialCells(xlLastCell).Select
>
> > > > N = ActiveCell.Row
> > > > If N >= 2 Then
>
> > > > Rows("1:" & N).Select
>
> > > > Selection.Copy
>
> > > > 'Sheets.Add After:=Sheets(Sheets.Count)
> > > > ask.Activate
> > > > ask.Sheets(1).Activate
> > > > Sheets(1).Select
> > > > Range("A1").Select
> > > > ActiveCell.SpecialCells(xlLastCell).Select
>
> > > > z = ActiveCell.Row + 2
>
> > > > Range("A" & z).Select
> > > > ActiveSheet.Paste
> > > > ActiveWorkbook.Save
> > > > ask2.Activate
> > > > ask2.Close
> > > > End If
>
> > > > Next i
>
> > > > 'abc:
> > > > 'Exit Sub
> > > > Application.DisplayAlerts = True
> > > > End Sub
>
> > > > On Thu, Jan 27, 2011 at 9:57 PM, ashish koul <koul.ash...@gmail.com>
> > > wrote:
>
> > > > > put sheetnames always in double quotes Sheets("PRIPRAVA_PROJEKTA").
>
> > > > > On Thu, Jan 27, 2011 at 9:23 PM, Seba <sebastjan.hri...@gmail.com>
> > > wrote:
>
> > > > >> Hi,
>
> > > > >> I made the following change for sheet name and I get the error
> > > > >> "Subscript out of range". Sheets(1) -> Sheets(PRIPRAVA_PROJEKTA)
>
> > > > >> Sub consolidatefromdifferentworkbooks()
> > > > >> Application.DisplayAlerts = False
> > > > >> 'On Error GoTo abc
> > > > >> Dim ask As Workbook
> > > > >> Dim ask2 As Workbook
> > > > >> Dim ASK3 As Workbook
> > > > >> Set ASK3 = ActiveWorkbook
> > > > >> Dim i As Long
> > > > >> Dim j As Long
> > > > >> Dim N, z, r, s, k As Long
> > > > >> s = 1
> > > > >> k = 1
> > > > >> Dim x As String
> > > > >> Dim temp As String
>
> > > > >> Sheets(1).Select
> > > > >> Range("A65356").Select
> > > > >> Selection.End(xlUp).Select
> > > > >> r = ActiveCell.Row
>
> > > > >> Workbooks.Open Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
> > > > >> Set ask = ActiveWorkbook
> > > > >> For i = 2 To r
>
> > > > >> 'Workbooks(Range("a" & i).Value).Windows(1).Visible = False
> > > > >> ASK3.Activate
> > > > >> Sheets(PRIPRAVA_PROJEKTA).Select
> > > > >> Workbooks.Open Filename:=Sheets(PRIPRAVA_PROJEKTA).Range("a" &
> > > > >> i).Value
> > > > >> Set ask2 = ActiveWorkbook
> > > > >> Sheets(PRIPRAVA_PROJEKTA).Select
>
> > > > >> Range("A1").Select
> > > > >> ActiveCell.SpecialCells(xlLastCell).Select
>
> > > > >> N = ActiveCell.Row
> > > > >> If N >= 2 Then
> > > > >> Rows("1:" & N).Select
>
> > > > >> Selection.Copy
>
> > > > >> 'Sheets.Add After:=Sheets(Sheets.Count)
> > > > >> ask.Activate
> > > > >> ask.Sheets(1).Activate
> > > > >> Sheets(1).Select
> > > > >> Range("A1").Select
> > > > >> ActiveCell.SpecialCells(xlLastCell).Select
>
> > > > >> z = ActiveCell.Row + 1
>
> > > > >> Range("A" & z).Select
> > > > >> ActiveSheet.Paste
> > > > >> ActiveWorkbook.Save
> > > > >> ask2.Activate
> > > > >> ask2.Close
> > > > >> End If
>
> > > > >> Next i
> > > > >> 'abc:
> > > > >> 'Exit Sub
> > > > >> Application.DisplayAlerts = True
> > > > >> End Sub
>
> > > > >> -------------------------
> > > > >> regards
> > > > >> seba
>
> > > > >> On 27 jan., 16:44, ashish koul <koul.ash...@gmail.com> wrote:
> > > > >> > shannur can you attch the sample workbook
>
> > > > >> > On Thu, Jan 27, 2011 at 9:13 PM, ashish koul <koul.ash...@gmail.com
>
> > > > >> wrote:
>
> > > > >> > > use 2 for second sheet or 3 for 3 rd sheet like
> > > > >> > > sheets(2).select or you can also sheets("abc").select
>
> > > > >> > > Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
> > > > >> > > Set ask2 = ActiveWorkbook
> > > > >> > > Sheets(1).Select
>
> > > > >> > > @shannur can you send a sample workbook
>
> > > > >> > > On Thu, Jan 27, 2011 at 9:04 PM, shannu shannu <
> > > shannur...@yahoo.com
> > > > >> >wrote:
>
> > > > >> > >> Hi Ashish,
>
> > > > >> > >> Life and death matter, I have a workbook and again it has diff
> > > sheets
> > > > >> like
> > > > >> > >> sheet 1 to sheet 11. and now my task is to copy unique names
> > > > >> > >> from
> > > > >> sheet 1
> > > > >> > >> search in other sheets if it is existing then I need to copy
> > > > >> > >> only
> > > > >> those row
> > > > >> > >> from the diff sheets and create a fresh new workbook and name
> > > > >> > >> the
> > > > >> workbook
> > > > >> > >> with that name of the person
>
> > > > >> > >> Regards,
> > > > >> > >> Shannur
>
> > > > >> > >> --- On *Thu, 1/27/11, ashish koul <koul.ash...@gmail.com>*
> > > wrote:
>
> > > > >> > >> From: ashish koul <koul.ash...@gmail.com>
>
> > > > >> > >> Subject: Re: $$Excel-Macros$$ build a database from multiple
> > > > >> workbooks
> > > > >> > >> To: excel-macros@googlegroups.com
> > > > >> > >> Date: Thursday, January 27, 2011, 2:10 PM
>
> > > > >> > >> On Thu, Jan 27, 2011 at 11:37 AM, ashish koul <
> > > > >> koul.ash...@gmail.com<
> > > > >> http://us.mc1200.mail.yahoo.com/mc/compose?to=koul.ash...@gmail.com>
> > > > >> > >> > wrote:
>
> > > > >> > >> Sub consolidatefromdifferentworkbooks()
> > > > >> > >> Application.DisplayAlerts = False
> > > > >> > >> 'On Error GoTo abc
> > > > >> > >> Dim ask As Workbook
> > > > >> > >> Dim ask2 As Workbook
> > > > >> > >> Dim ASK3 As Workbook
> > > > >> > >> Set ASK3 = ActiveWorkbook
> > > > >> > >> Dim i As Long
> > > > >> > >> Dim j As Long
> > > > >> > >> Dim N, z, r, s, k, d As Long
> > > > >> > >> s = 1
> > > > >> > >> k = 1
> > > > >> > >> Dim x As String
> > > > >> > >> Dim temp As String
> > > > >> > >> Dim sht As Worksheet
>
> > > > >> > >> Set ask2 = ActiveWorkbook
> > > > >> > >> Sheets(1).Select
> > > > >> > >> Range("A65356").Select
> > > > >> > >> Selection.End(xlUp).Select
> > > > >> > >> r = ActiveCell.Row
>
> > > > >> > >> Workbooks.Open
> > > Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
> > > > >> > >> Set ask = ActiveWorkbook
>
> > > > >> > >> For i = 2 To r
> > > > >> > >> 'Workbooks(Range("a" & i).Value).Windows(1).Visible = False
> > > > >> > >> ASK3.Activate
> > > > >> > >> Sheets(1).Select
> > > > >> > >> Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
> > > > >> > >> Set ask2 = ActiveWorkbook
>
> > > > >> > >> For d = 1 To ask2.Sheets.Count
> > > > >> > >> Sheets(d).Activate
> > > > >> > >> Sheets(d).Select
> > > > >> > >> Range("A1").Select
> > > > >> > >> ActiveCell.SpecialCells(xlLastCell).Select
>
> > > > >> > >> ' Selection.End(xlToRight).Select
> > > > >> > >> '
> > > > >> > >> '
> > > > >> > >> 'temp = ActiveCell.Address
> > > > >> > >> 'x = Mid(temp, 2, (InStr(2, temp, "$") - 2))
> > > > >> > >> '
> > > > >> > >> '
> > > > >> > >> '
> > > > >> > >> ' Range("A65356").Select
> > > > >> > >> ' Selection.End(xlUp).Select
> > > > >> > >> N
>
> ...
>
> preberite več >>
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
